home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXDBCTRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  106.3 KB  |  3,814 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RXDBCtrl;
  13.  
  14. {$I RX.INC}
  15. {$R-}
  16.  
  17. interface
  18.  
  19. uses 
  20.   Windows, Registry, Variants, Messages, Classes, Controls, Forms, Grids, Graphics, Buttons, Menus,
  21.   StdCtrls, Mask, IniFiles, ToolEdit, DB, DBGrids, 
  22.   {$IFNDEF RX_D3} DBTables, {$ENDIF}
  23.   Placemnt, DateUtil, DBCtrls, RxCtrls, CurrEdit;
  24.  
  25. { TRxDBGrid }
  26.  
  27. const
  28.   DefRxGridOptions = [dgEditing, dgTitles, dgIndicator, dgColumnResize,
  29.     dgColLines, dgRowLines, dgConfirmDelete, dgCancelOnExit];
  30.  
  31. {$IFDEF RX_V110}
  32.  {$IFDEF CBUILDER}
  33.   {$NODEFINE DefRxGridOptions}
  34.  {$ENDIF}
  35. {$ENDIF}
  36.  
  37. type
  38.   TTitleClickEvent = procedure (Sender: TObject; ACol: Longint;
  39.     Field: TField) of object;
  40.   TCheckTitleBtnEvent = procedure (Sender: TObject; ACol: Longint;
  41.     Field: TField; var Enabled: Boolean) of object;
  42.   TGetCellParamsEvent = procedure (Sender: TObject; Field: TField;
  43.     AFont: TFont; var Background: TColor; Highlight: Boolean) of object;
  44.   TSortMarker = (smNone, smDown, smUp);
  45.   TGetBtnParamsEvent = procedure (Sender: TObject; Field: TField;
  46.     AFont: TFont; var Background: TColor; var SortMarker: TSortMarker;
  47.     IsDown: Boolean) of object;
  48.   TGetCellPropsEvent = procedure (Sender: TObject; Field: TField;
  49.     AFont: TFont; var Background: TColor) of object; { obsolete }
  50.   TDBEditShowEvent = procedure (Sender: TObject; Field: TField;
  51.     var AllowEdit: Boolean) of object;
  52.  
  53. {$IFNDEF WIN32}
  54.   TBookmarkList = class
  55.   private
  56.     FList: THugeList;
  57.     FGrid: TCustomDBGrid;
  58.     FCache: TBookmark;
  59.     FCacheIndex: Longint;
  60.     FCacheFind: Boolean;
  61.     FLinkActive: Boolean;
  62.     function GetCount: Longint;
  63.     function GetCurrentRowSelected: Boolean;
  64.     function GetItem(Index: Longint): TBookmark;
  65.     procedure SetCurrentRowSelected(Value: Boolean);
  66.     procedure ListChanged;
  67.   protected
  68.     function CurrentRow: TBookmark;
  69.     function Compare(const Item1, Item2: TBookmark): Longint;
  70.     procedure LinkActive(Value: Boolean);
  71.   public
  72.     constructor Create(AGrid: TCustomDBGrid);
  73.     destructor Destroy; override;
  74.     procedure Clear;  { free all bookmarks }
  75.     procedure Delete; { delete all selected rows from dataset }
  76.     function Find(const Item: TBookmark; var Index: Longint): Boolean;
  77.     function IndexOf(const Item: TBookmark): Longint;
  78.     function Refresh: Boolean; { drop orphaned bookmarks; True = orphans found }
  79.     property Count: Longint read GetCount;
  80.     property CurrentRowSelected: Boolean read GetCurrentRowSelected
  81.       write SetCurrentRowSelected;
  82.     property Items[Index: Longint]: TBookmark read GetItem; default;
  83.   end;
  84. {$ENDIF}
  85.  
  86.   TRxDBGrid = class(TDBGrid)
  87.   private
  88.     FShowGlyphs: Boolean;
  89.     FDefaultDrawing: Boolean;
  90.     FMultiSelect: Boolean;
  91.     FSelecting: Boolean;
  92.     FClearSelection: Boolean;
  93.     FTitleButtons: Boolean;
  94. {$IFDEF WIN32}
  95.     FPressedCol: TColumn;
  96. {$ELSE}
  97.     FPressedCol: Longint;
  98. {$ENDIF}
  99.     FPressed: Boolean;
  100.     FTracking: Boolean;
  101.     FSwapButtons: Boolean;
  102.     FIniLink: TIniLink;
  103.     FDisableCount: Integer;
  104.     FFixedCols: Integer;
  105.     FMsIndicators: TImageList;
  106.     FOnCheckButton: TCheckTitleBtnEvent;
  107.     FOnGetCellProps: TGetCellPropsEvent;
  108.     FOnGetCellParams: TGetCellParamsEvent;
  109.     FOnGetBtnParams: TGetBtnParamsEvent;
  110.     FOnEditChange: TNotifyEvent;
  111.     FOnKeyPress: TKeyPressEvent;
  112.     FOnTitleBtnClick: TTitleClickEvent;
  113.     FOnShowEditor: TDbEditShowEvent;
  114.     FOnTopLeftChanged: TNotifyEvent;
  115. {$IFDEF WIN32}
  116.     FSelectionAnchor: TBookmarkStr;
  117. {$ELSE}
  118.     FSelectionAnchor: TBookmark;
  119.     FBookmarks: TBookmarkList;
  120.     FOnColumnMoved: TMovedEvent;
  121. {$ENDIF}
  122.     function GetImageIndex(Field: TField): Integer;
  123.     procedure SetShowGlyphs(Value: Boolean);
  124.     procedure SetRowsHeight(Value: Integer);
  125.     function GetRowsHeight: Integer;
  126.     function GetStorage: TFormPlacement;
  127.     procedure SetStorage(Value: TFormPlacement);
  128.     procedure IniSave(Sender: TObject);
  129.     procedure IniLoad(Sender: TObject);
  130.     procedure SetMultiSelect(Value: Boolean);
  131.     procedure SetTitleButtons(Value: Boolean);
  132.     procedure StopTracking;
  133.     procedure TrackButton(X, Y: Integer);
  134.     function ActiveRowSelected: Boolean;
  135.     function GetSelCount: Longint;
  136.     procedure InternalSaveLayout(IniFile: TObject; const Section: string);
  137.     procedure InternalRestoreLayout(IniFile: TObject; const Section: string);
  138. {$IFDEF WIN32}
  139.     procedure SaveColumnsLayout(IniFile: TObject; const Section: string);
  140.     procedure RestoreColumnsLayout(IniFile: TObject; const Section: string);
  141.     function GetOptions: TDBGridOptions;
  142.     procedure SetOptions(Value: TDBGridOptions);
  143.     function GetMasterColumn(ACol, ARow: Longint): TColumn;
  144. {$ELSE}
  145.     function GetFixedColor: TColor;
  146.     procedure SetFixedColor(Value: TColor);
  147.     function GetIndicatorOffset: Byte;
  148. {$ENDIF}
  149.     function GetTitleOffset: Byte;
  150.     procedure SetFixedCols(Value: Integer);
  151.     function GetFixedCols: Integer;
  152. {$IFDEF RX_D4}
  153.     function CalcLeftColumn: Integer;
  154. {$ENDIF}
  155.     procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  156.     procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
  157. {$IFDEF WIN32}
  158.     procedure WMRButtonUp(var Message: TWMMouse); message WM_RBUTTONUP;
  159. {$ENDIF}
  160.   protected
  161.     function AcquireFocus: Boolean;
  162.     function CanEditShow: Boolean; override;
  163.     function CreateEditor: TInplaceEdit; override;
  164.     procedure DoTitleClick(ACol: Longint; AField: TField); dynamic;
  165.     procedure CheckTitleButton(ACol, ARow: Longint; var Enabled: Boolean); dynamic;
  166.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  167.     procedure DrawDataCell(const Rect: TRect; Field: TField;
  168.       State: TGridDrawState); override; { obsolete from Delphi 2.0 }
  169.     procedure EditChanged(Sender: TObject); dynamic;
  170.     procedure GetCellProps(Field: TField; AFont: TFont; var Background: TColor;
  171.       Highlight: Boolean); dynamic;
  172.     function HighlightCell(DataCol, DataRow: Integer; const Value: string;
  173.       AState: TGridDrawState): Boolean; override;
  174.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  175.     procedure KeyPress(var Key: Char); override;
  176.     procedure SetColumnAttributes; override;
  177.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  178.       X, Y: Integer); override;
  179.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  180.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  181.       X, Y: Integer); override;
  182. {$IFDEF RX_D4}
  183.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  184.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  185. {$ENDIF}
  186.     procedure Scroll(Distance: Integer); override;
  187.     procedure LayoutChanged; override;
  188.     procedure TopLeftChanged; override;
  189. {$IFDEF WIN32}
  190.     procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
  191.       Column: TColumn; State: TGridDrawState); override;
  192.     procedure ColWidthsChanged; override;
  193. {$ELSE}
  194.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  195.     procedure LinkActive(Value: Boolean); override;
  196. {$ENDIF}
  197.     procedure Paint; override;
  198.   public
  199.     constructor Create(AOwner: TComponent); override;
  200.     destructor Destroy; override;
  201.     procedure DefaultDataCellDraw(const Rect: TRect; Field: TField;
  202.       State: TGridDrawState);
  203.     procedure DisableScroll;
  204.     procedure EnableScroll;
  205.     function ScrollDisabled: Boolean;
  206.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  207.     procedure SaveLayout(IniFile: TIniFile);
  208.     procedure RestoreLayout(IniFile: TIniFile);
  209.     procedure SelectAll;
  210.     procedure UnselectAll;
  211.     procedure ToggleRowSelection;
  212.     procedure GotoSelection(Index: Longint);
  213. {$IFDEF WIN32}
  214.     procedure SaveLayoutReg(IniFile: TRegIniFile);
  215.     procedure RestoreLayoutReg(IniFile: TRegIniFile);
  216.     property SelectedRows;
  217. {$ELSE}
  218.     property SelectedRows: TBookmarkList read FBookmarks;
  219. {$ENDIF WIN32}
  220.     property SelCount: Longint read GetSelCount;
  221.     property Canvas;
  222.     property Col;
  223.     property InplaceEditor;
  224.     property LeftCol;
  225.     property Row;
  226.     property VisibleRowCount;
  227.     property VisibleColCount;
  228.     property IndicatorOffset {$IFNDEF WIN32}: Byte read GetIndicatorOffset {$ENDIF};
  229.     property TitleOffset: Byte read GetTitleOffset;
  230.   published
  231. {$IFDEF WIN32}
  232.     property Options: TDBGridOptions read GetOptions write SetOptions
  233.       default DefRxGridOptions;
  234. {$ELSE}
  235.     property FixedColor: TColor read GetFixedColor write SetFixedColor
  236.       default clBtnFace; { fix Delphi 1.0 bug }
  237.     property Options default DefRxGridOptions;
  238. {$ENDIF}
  239.     property FixedCols: Integer read GetFixedCols write SetFixedCols default 0;
  240.     property ClearSelection: Boolean read FClearSelection write FClearSelection
  241.       default True;
  242.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing
  243.       default True;
  244.     property IniStorage: TFormPlacement read GetStorage write SetStorage;
  245.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect
  246.       default False;
  247.     property ShowGlyphs: Boolean read FShowGlyphs write SetShowGlyphs
  248.       default True;
  249.     property TitleButtons: Boolean read FTitleButtons write SetTitleButtons
  250.       default False;
  251.     property RowsHeight: Integer read GetRowsHeight write SetRowsHeight
  252.       stored False; { obsolete, for backward compatibility only }
  253.     property OnCheckButton: TCheckTitleBtnEvent read FOnCheckButton write FOnCheckButton;
  254.     property OnGetCellProps: TGetCellPropsEvent read FOnGetCellProps
  255.       write FOnGetCellProps; { obsolete }
  256.     property OnGetCellParams: TGetCellParamsEvent read FOnGetCellParams write FOnGetCellParams;
  257.     property OnGetBtnParams: TGetBtnParamsEvent read FOnGetBtnParams write FOnGetBtnParams;
  258.     property OnEditChange: TNotifyEvent read FOnEditChange write FOnEditChange;
  259.     property OnShowEditor: TDBEditShowEvent read FOnShowEditor write FOnShowEditor;
  260.     property OnTitleBtnClick: TTitleClickEvent read FOnTitleBtnClick write FOnTitleBtnClick;
  261.     property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
  262.     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  263. {$IFNDEF WIN32}
  264.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
  265. {$ENDIF}
  266. {$IFDEF RX_D5}
  267.     property OnContextPopup;
  268. {$ENDIF}
  269.     property OnMouseDown;
  270.     property OnMouseMove;
  271.     property OnMouseUp;
  272. {$IFDEF RX_D4}
  273.     property OnMouseWheelDown;
  274.     property OnMouseWheelUp;
  275. {$ENDIF}
  276.   end;
  277.  
  278. { TRxDBComboEdit }
  279.  
  280.   TRxDBComboEdit = class(TCustomComboEdit)
  281.   private
  282.     FDataLink: TFieldDataLink;
  283. {$IFDEF WIN32}
  284.     FCanvas: TControlCanvas;
  285. {$ENDIF}
  286.     FFocused: Boolean;
  287.     procedure DataChange(Sender: TObject);
  288.     procedure EditingChange(Sender: TObject);
  289.     function GetDataField: string;
  290.     function GetDataSource: TDataSource;
  291.     function GetField: TField;
  292.     procedure SetDataField(const Value: string);
  293.     procedure SetDataSource(Value: TDataSource);
  294.     procedure SetFocused(Value: Boolean);
  295.     procedure SetReadOnly(Value: Boolean);
  296.     procedure UpdateData(Sender: TObject);
  297.     procedure WMCut(var Message: TMessage); message WM_CUT;
  298.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  299.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  300.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  301. {$IFDEF WIN32}
  302.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  303.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  304. {$ENDIF}
  305.   protected
  306.     procedure Change; override;
  307.     function EditCanModify: Boolean; override;
  308.     function GetReadOnly: Boolean; override;
  309.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  310.     procedure KeyPress(var Key: Char); override;
  311.     procedure Loaded; override;
  312.     procedure Notification(AComponent: TComponent;
  313.       Operation: TOperation); override;
  314.     procedure Reset; override;
  315.   public
  316.     constructor Create(AOwner: TComponent); override;
  317.     destructor Destroy; override;
  318. {$IFDEF RX_D4}
  319.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  320.     function UpdateAction(Action: TBasicAction): Boolean; override;
  321.     function UseRightToLeftAlignment: Boolean; override;
  322. {$ENDIF}
  323.     property Button;
  324.     property Field: TField read GetField;
  325.   published
  326.     property AutoSelect;
  327.     property BorderStyle;
  328.     property ButtonHint;
  329.     property CharCase;
  330.     property ClickKey;
  331.     property Color;
  332.     property Ctl3D;
  333.     property DataField: string read GetDataField write SetDataField;
  334.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  335.     property DirectInput;
  336.     property DragCursor;
  337.     property DragMode;
  338.     property Enabled;
  339.     property Font;
  340.     property GlyphKind;
  341.     { Ensure GlyphKind is published before Glyph and ButtonWidth }
  342.     property Glyph;
  343.     property ButtonWidth;
  344.     property HideSelection;
  345. {$IFDEF RX_D4}
  346.     property Anchors;
  347.     property BiDiMode;
  348.     property Constraints;
  349.     property DragKind;
  350.     property ParentBiDiMode;
  351. {$ENDIF}
  352. {$IFDEF WIN32}
  353.   {$IFNDEF VER90}
  354.     property ImeMode;
  355.     property ImeName;
  356.   {$ENDIF}
  357. {$ENDIF}
  358.     property MaxLength;
  359.     property NumGlyphs;
  360.     property ParentColor;
  361.     property ParentCtl3D;
  362.     property ParentFont;
  363.     property ParentShowHint;
  364.     property PopupMenu;
  365.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  366.     property ShowHint;
  367.     property TabOrder;
  368.     property TabStop;
  369.     property Visible;
  370.     property OnButtonClick;
  371.     property OnChange;
  372.     property OnClick;
  373.     property OnDblClick;
  374.     property OnDragDrop;
  375.     property OnDragOver;
  376.     property OnEndDrag;
  377.     property OnEnter;
  378.     property OnExit;
  379.     property OnKeyDown;
  380.     property OnKeyPress;
  381.     property OnKeyUp;
  382.     property OnMouseDown;
  383.     property OnMouseMove;
  384.     property OnMouseUp;
  385. {$IFDEF WIN32}
  386.     property OnStartDrag;
  387. {$ENDIF}
  388. {$IFDEF RX_D5}
  389.     property OnContextPopup;
  390. {$ENDIF}
  391. {$IFDEF RX_D4}
  392.     property OnEndDock;
  393.     property OnStartDock;
  394. {$ENDIF}
  395.   end;
  396.  
  397. { TDBDateEdit }
  398.  
  399.   TDBDateEdit = class(TCustomDateEdit)
  400.   private
  401.     FDataLink: TFieldDataLink;
  402. {$IFDEF WIN32}
  403.     FCanvas: TControlCanvas;
  404. {$ENDIF}
  405.     procedure DataChange(Sender: TObject);
  406.     procedure EditingChange(Sender: TObject);
  407.     function GetDataField: string;
  408.     function GetDataSource: TDataSource;
  409.     function GetField: TField;
  410.     procedure SetDataField(const Value: string);
  411.     procedure SetDataSource(Value: TDataSource);
  412.     procedure SetReadOnly(Value: Boolean);
  413.     procedure UpdateData(Sender: TObject);
  414.     procedure AfterPopup(Sender: TObject; var Date: TDateTime; var Action: Boolean);
  415.     procedure WMCut(var Message: TMessage); message WM_CUT;
  416.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  417.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  418.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  419. {$IFDEF WIN32}
  420.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  421.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  422. {$ENDIF}
  423.   protected
  424. {$IFDEF WIN32}
  425.     procedure AcceptValue(const Value: Variant); override;
  426. {$ENDIF}
  427.     procedure ApplyDate(Value: TDateTime); override;
  428.     function GetReadOnly: Boolean; override;
  429.     procedure Change; override;
  430.     function EditCanModify: Boolean; override;
  431.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  432.     procedure KeyPress(var Key: Char); override;
  433.     procedure Notification(AComponent: TComponent;
  434.       Operation: TOperation); override;
  435.     procedure Reset; override;
  436.   public
  437.     constructor Create(AOwner: TComponent); override;
  438.     destructor Destroy; override;
  439.     procedure UpdateMask; override;
  440. {$IFDEF RX_D4}
  441.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  442.     function UpdateAction(Action: TBasicAction): Boolean; override;
  443.     function UseRightToLeftAlignment: Boolean; override;
  444. {$ENDIF}
  445.     property Field: TField read GetField;
  446.   published
  447.     property CalendarHints;
  448.     property DataField: string read GetDataField write SetDataField;
  449.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  450.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  451.     property AutoSelect;
  452.     property BlanksChar;
  453.     property BorderStyle;
  454.     property ButtonHint;
  455.     property CheckOnExit;
  456.     property ClickKey;
  457.     property Color;
  458.     property Ctl3D;
  459.     property DefaultToday;
  460.     property DialogTitle;
  461.     property DirectInput;
  462.     property DragCursor;
  463.     property DragMode;
  464.     property Enabled;
  465.     property Font;
  466.     property GlyphKind;
  467.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  468.     property Glyph;
  469.     property ButtonWidth;
  470.     property HideSelection;
  471. {$IFDEF RX_D4}
  472.     property Anchors;
  473.     property BiDiMode;
  474.     property Constraints;
  475.     property DragKind;
  476.     property ParentBiDiMode;
  477. {$ENDIF}
  478. {$IFDEF WIN32}
  479.   {$IFNDEF VER90}
  480.     property ImeMode;
  481.     property ImeName;
  482.   {$ENDIF}
  483. {$ENDIF}
  484.     property MaxLength;
  485.     property NumGlyphs;
  486.     property ParentColor;
  487.     property ParentCtl3D;
  488.     property ParentFont;
  489.     property ParentShowHint;
  490.     property PopupAlign;
  491.     property PopupColor;
  492.     property PopupMenu;
  493.     property ShowHint;
  494.     property CalendarStyle;
  495.     property TabOrder;
  496.     property TabStop;
  497.     property StartOfWeek;
  498.     property Weekends;
  499.     property WeekendColor;
  500.     property YearDigits;
  501.     property Visible;
  502.     property OnButtonClick;
  503.     property OnChange;
  504.     property OnClick;
  505.     property OnDblClick;
  506.     property OnDragDrop;
  507.     property OnDragOver;
  508.     property OnEndDrag;
  509.     property OnEnter;
  510.     property OnExit;
  511.     property OnKeyDown;
  512.     property OnKeyPress;
  513.     property OnKeyUp;
  514.     property OnMouseDown;
  515.     property OnMouseMove;
  516.     property OnMouseUp;
  517. {$IFDEF WIN32}
  518.     property OnStartDrag;
  519. {$ENDIF}
  520. {$IFDEF RX_D5}
  521.     property OnContextPopup;
  522. {$ENDIF}
  523. {$IFDEF RX_D4}
  524.     property OnEndDock;
  525.     property OnStartDock;
  526. {$ENDIF}
  527.   end;
  528.  
  529. { TRxDBCalcEdit }
  530.  
  531.   TRxDBCalcEdit = class(TRxCustomCalcEdit)
  532.   private
  533.     FDataLink: TFieldDataLink;
  534.     FDefaultParams: Boolean;
  535.     procedure DataChange(Sender: TObject);
  536.     procedure EditingChange(Sender: TObject);
  537.     function GetDataField: string;
  538.     function GetDataSource: TDataSource;
  539.     function GetField: TField;
  540.     procedure SetDataField(const Value: string);
  541.     procedure SetDataSource(Value: TDataSource);
  542.     procedure SetDefaultParams(Value: Boolean);
  543.     procedure SetReadOnly(Value: Boolean);
  544.     procedure UpdateFieldData(Sender: TObject);
  545.     procedure WMCut(var Message: TMessage); message WM_CUT;
  546.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  547.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  548.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  549. {$IFDEF WIN32}
  550.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  551. {$ENDIF}
  552.   protected
  553. {$IFDEF WIN32}
  554.     procedure AcceptValue(const Value: Variant); override;
  555.     function GetDisplayText: string; override;
  556. {$ENDIF}
  557.     function GetReadOnly: Boolean; override;
  558.     procedure Change; override;
  559.     function EditCanModify: Boolean; override;
  560.     function IsValidChar(Key: Char): Boolean; override;
  561.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  562.     procedure KeyPress(var Key: Char); override;
  563.     procedure Notification(AComponent: TComponent;
  564.       Operation: TOperation); override;
  565.     procedure Reset; override;
  566.     procedure UpdatePopup; override;
  567.   public
  568.     constructor Create(AOwner: TComponent); override;
  569.     destructor Destroy; override;
  570.     procedure UpdateFieldParams;
  571. {$IFDEF RX_D4}
  572.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  573.     function UpdateAction(Action: TBasicAction): Boolean; override;
  574.     function UseRightToLeftAlignment: Boolean; override;
  575. {$ENDIF}
  576.     property Field: TField read GetField;
  577.     property Value;
  578.   published
  579.     property DataField: string read GetDataField write SetDataField;
  580.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  581.     property DefaultParams: Boolean read FDefaultParams write SetDefaultParams default False;
  582.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  583.     property Alignment;
  584.     property AutoSelect;
  585.     property BeepOnError;
  586.     property BorderStyle;
  587.     property ButtonHint;
  588.     property CheckOnExit;
  589.     property ClickKey;
  590.     property Color;
  591.     property Ctl3D;
  592.     property DecimalPlaces;
  593.     property DirectInput;
  594.     property DisplayFormat;
  595.     property DragCursor;
  596.     property DragMode;
  597.     property Enabled;
  598.     property Font;
  599.     property FormatOnEditing;
  600.     property GlyphKind;
  601.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  602.     property Glyph;
  603.     property ButtonWidth;
  604.     property HideSelection;
  605. {$IFDEF RX_D4}
  606.     property Anchors;
  607.     property BiDiMode;
  608.     property Constraints;
  609.     property DragKind;
  610.     property ParentBiDiMode;
  611. {$ENDIF}
  612. {$IFDEF WIN32}
  613.   {$IFNDEF VER90}
  614.     property ImeMode;
  615.     property ImeName;
  616.   {$ENDIF}
  617. {$ENDIF}
  618.     property MaxLength;
  619.     property MaxValue;
  620.     property MinValue;
  621.     property NumGlyphs;
  622.     property ParentColor;
  623.     property ParentCtl3D;
  624.     property ParentFont;
  625.     property ParentShowHint;
  626.     property PopupAlign;
  627.     property PopupMenu;
  628.     property ShowHint;
  629.     property TabOrder;
  630.     property TabStop;
  631.     property Visible;
  632.     property ZeroEmpty;
  633.     property OnButtonClick;
  634.     property OnChange;
  635.     property OnClick;
  636.     property OnDblClick;
  637.     property OnDragDrop;
  638.     property OnDragOver;
  639.     property OnEndDrag;
  640.     property OnEnter;
  641.     property OnExit;
  642.     property OnKeyDown;
  643.     property OnKeyPress;
  644.     property OnKeyUp;
  645.     property OnMouseDown;
  646.     property OnMouseMove;
  647.     property OnMouseUp;
  648. {$IFDEF WIN32}
  649.     property OnStartDrag;
  650. {$ENDIF}
  651. {$IFDEF RX_D5}
  652.     property OnContextPopup;
  653. {$ENDIF}
  654. {$IFDEF RX_D4}
  655.     property OnEndDock;
  656.     property OnStartDock;
  657. {$ENDIF}
  658.   end;
  659.  
  660. { TDBStatusLabel }
  661.  
  662.   TGetStringEvent = function(Sender: TObject): string of object;
  663.   TDataValueEvent = procedure(Sender: TObject; DataSet: TDataSet;
  664.     var Value: Longint) of object;
  665.   TDBLabelStyle = (lsState, lsRecordNo, lsRecordSize);
  666.   TGlyphAlign = glGlyphLeft..glGlyphRight;
  667.   TDBStatusKind = dsInactive..dsCalcFields;
  668.   TDBLabelOptions = (doCaption, doGlyph, doBoth);
  669.  
  670.   TDBStatusLabel = class(TRxCustomLabel)
  671.   private
  672.     FDataLink: TDataLink;
  673.     FDataSetName: String;
  674.     FStyle: TDBLabelStyle;
  675.     FEditColor: TColor;
  676.     FCalcCount: Boolean;
  677.     FCaptions: TStrings;
  678.     FGlyph: TBitmap;
  679.     FCell: TBitmap;
  680.     FGlyphAlign: TGlyphAlign;
  681.     FRecordCount: Longint;
  682.     FRecordNo: Longint;
  683.     FShowOptions: TDBLabelOptions;
  684.     FOnGetDataName: TGetStringEvent;
  685.     FOnGetRecNo: TDataValueEvent;
  686.     FOnGetRecordCount: TDataValueEvent;
  687.     function GetStatusKind(State: TDataSetState): TDBStatusKind;
  688.     procedure CaptionsChanged(Sender: TObject);
  689.     function GetDataSetName: string;
  690.     procedure SetDataSetName(Value: string);
  691.     function GetDataSource: TDataSource;
  692.     procedure SetDataSource(Value: TDataSource);
  693.     function GetDatasetState: TDataSetState;
  694.     procedure SetEditColor(Value: TColor);
  695.     procedure SetStyle(Value: TDBLabelStyle);
  696.     procedure SetShowOptions(Value: TDBLabelOptions);
  697.     procedure SetGlyphAlign(Value: TGlyphAlign);
  698.     procedure SetCaptions(Value: TStrings);
  699.     procedure SetCalcCount(Value: Boolean);
  700.   protected
  701.     procedure Loaded; override;
  702.     function GetDefaultFontColor: TColor; override;
  703.     function GetLabelCaption: string; override;
  704.     function GetCaption(State: TDataSetState): string; virtual;
  705.     procedure Notification(AComponent: TComponent;
  706.       Operation: TOperation); override;
  707.     procedure Paint; override;
  708.     procedure SetName(const Value: TComponentName); override;
  709.   public
  710.     constructor Create(AOwner: TComponent); override;
  711.     destructor Destroy; override;
  712.     procedure UpdateData; virtual;
  713.     procedure UpdateStatus; virtual;
  714.     property Caption;
  715.     property DatasetState: TDataSetState read GetDatasetState;
  716.   published
  717.     property DatasetName: string read GetDataSetName write SetDataSetName;
  718.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  719.     property EditColor: TColor read FEditColor write SetEditColor default clRed;
  720.     property Captions: TStrings read FCaptions write SetCaptions;
  721.     property Style: TDBLabelStyle read FStyle write SetStyle default lsState;
  722.     property CalcRecCount: Boolean read FCalcCount write SetCalcCount default False;
  723.     property ShowOptions: TDBLabelOptions read FShowOptions write SetShowOptions
  724.       default doCaption;
  725.     property GlyphAlign: TGlyphAlign read FGlyphAlign write SetGlyphAlign
  726.       default glGlyphLeft;
  727.     property Layout default tlCenter;
  728.     property ShadowSize default 0;
  729.     property Align;
  730.     property Alignment;
  731.     property AutoSize;
  732.     property Color;
  733.     property DragCursor;
  734.     property DragMode;
  735.     property Font;
  736. {$IFDEF RX_D4}
  737.     property Anchors;
  738.     property BiDiMode;
  739.     property Constraints;
  740.     property DragKind;
  741.     property ParentBiDiMode;
  742. {$ENDIF}
  743.     property ParentColor;
  744.     property ParentFont;
  745.     property ParentShowHint;
  746.     property PopupMenu;
  747.     property ShadowColor;
  748.     property ShadowPos;
  749.     property ShowHint;
  750.     property Transparent;
  751.     property Visible;
  752.     property WordWrap;
  753.     property OnGetDataName: TGetStringEvent read FOnGetDataName write FOnGetDataName;
  754.     property OnGetRecordCount: TDataValueEvent read FOnGetRecordCount
  755.       write FOnGetRecordCount;
  756.     property OnGetRecNo: TDataValueEvent read FOnGetRecNo write FOnGetRecNo;
  757.     property OnClick;
  758.     property OnDblClick;
  759.     property OnDragDrop;
  760.     property OnDragOver;
  761.     property OnEndDrag;
  762.     property OnMouseDown;
  763.     property OnMouseMove;
  764.     property OnMouseUp;
  765.     property OnMouseEnter;
  766.     property OnMouseLeave;
  767. {$IFDEF WIN32}
  768.     property OnStartDrag;
  769. {$ENDIF}
  770. {$IFDEF RX_D5}
  771.     property OnContextPopup;
  772. {$ENDIF}
  773. {$IFDEF RX_D4}
  774.     property OnEndDock;
  775.     property OnStartDock;
  776. {$ENDIF}
  777.   end;
  778.  
  779. implementation
  780.  
  781. uses SysUtils, rxStrUtils, Dialogs, ExtCtrls, DbConsts, AppUtils, VCLUtils,
  782.   DbUtils, {$IFNDEF RX_D3} BdeUtils, {$ENDIF} PickDate, RxCalc, MaxMin,
  783.   RxDConst;
  784.  
  785. {$IFDEF WIN32}
  786.   {$R *.R32}
  787. {$ELSE}
  788.   {$R *.R16}
  789. {$ENDIF}
  790.  
  791. type
  792.   TGridPicture = (gpBlob, gpMemo, gpPicture, gpOle, gpObject, gpData,
  793.     gpNotEmpty, gpMarkDown, gpMarkUp);
  794.  
  795. const
  796.   GridBmpNames: array[TGridPicture] of PChar =
  797.     ('DBG_BLOB', 'DBG_MEMO', 'DBG_PICT', 'DBG_OLE', 'DBG_OBJECT', 'DBG_DATA',
  798.      'DBG_NOTEMPTY', 'DBG_SMDOWN', 'DBG_SMUP');
  799.   GridBitmaps: array[TGridPicture] of TBitmap =
  800.     (nil, nil, nil, nil, nil, nil, nil, nil, nil);
  801.   bmMultiDot = 'DBG_MSDOT';
  802.   bmMultiArrow = 'DBG_MSARROW';
  803.  
  804. function GetGridBitmap(BmpType: TGridPicture): TBitmap;
  805. begin
  806.   if GridBitmaps[BmpType] = nil then begin
  807.     GridBitmaps[BmpType] := TBitmap.Create;
  808.     GridBitmaps[BmpType].Handle := LoadBitmap(HInstance, GridBmpNames[BmpType]);
  809.   end;
  810.   Result := GridBitmaps[BmpType];
  811. end;
  812.  
  813. procedure DestroyLocals; far;
  814. var
  815.   I: TGridPicture;
  816. begin
  817.   for I := Low(TGridPicture) to High(TGridPicture) do GridBitmaps[I].Free;
  818. end;
  819.  
  820. procedure GridInvalidateRow(Grid: TRxDBGrid; Row: Longint);
  821. var
  822.   I: Longint;
  823. begin
  824.   for I := 0 to Grid.ColCount - 1 do Grid.InvalidateCell(I, Row);
  825. end;
  826.  
  827. {$IFNDEF WIN32}
  828.  
  829. { TBookmarkList }
  830.  
  831. constructor TBookmarkList.Create(AGrid: TCustomDBGrid);
  832. begin
  833.   inherited Create;
  834.   FList := THugeList.Create;
  835.   FGrid := AGrid;
  836. end;
  837.  
  838. destructor TBookmarkList.Destroy;
  839. begin
  840.   Clear;
  841.   FList.Free;
  842.   inherited Destroy;
  843. end;
  844.  
  845. procedure TBookmarkList.Clear;
  846. var
  847.   I: Longint;
  848. begin
  849.   if FList.Count = 0 then Exit;
  850.   for I := FList.Count - 1 downto 0 do StrDispose(FList[I]);
  851.   FList.Clear;
  852.   ListChanged;
  853.   FGrid.Invalidate;
  854. end;
  855.  
  856. function TBookmarkList.Compare(const Item1, Item2: TBookmark): Longint;
  857. begin
  858.   Result := BookmarksCompare(TRxDBGrid(FGrid).Datalink.Dataset,
  859.     Item1, Item2);
  860. end;
  861.  
  862. function TBookmarkList.CurrentRow: TBookmark;
  863. begin
  864.   if not FLinkActive then _DBError(sDataSetClosed);
  865.   Result := TRxDBGrid(FGrid).Datalink.Dataset.GetBookmark;
  866. end;
  867.  
  868. function TBookmarkList.GetCurrentRowSelected: Boolean;
  869. var
  870.   Index: Longint;
  871.   Row: TBookmark;
  872. begin
  873.   Row := CurrentRow;
  874.   try
  875.     Result := Find(Row, Index);
  876.   finally
  877.     StrDispose(Row);
  878.   end;
  879. end;
  880.  
  881. function TBookmarkList.Find(const Item: TBookmark; var Index: Longint): Boolean;
  882. var
  883.   L, H, I, C: Longint;
  884.   P: PChar;
  885. begin
  886.   if (Compare(Item, FCache) = 0) and (FCacheIndex >= 0) then begin
  887.     Index := FCacheIndex;
  888.     Result := FCacheFind;
  889.     Exit;
  890.   end;
  891.   Result := False;
  892.   L := 0;
  893.   H := FList.Count - 1;
  894.   while L <= H do begin
  895.     I := (L + H) shr 1;
  896.     C := Compare(TBookmark(FList[I]), Item);
  897.     if C < 0 then L := I + 1
  898.     else begin
  899.       H := I - 1;
  900.       if C = 0 then begin
  901.         Result := True;
  902.         L := I;
  903.       end;
  904.     end;
  905.   end;
  906.   Index := L;
  907.   StrDispose(FCache);
  908.   FCache := nil;
  909.   P := PChar(Item);
  910.   if P <> nil then begin
  911.     Dec(P, 2);
  912.     FCache := StrAlloc(Word(Pointer(P)^));
  913.     Move(Item^, FCache^, Word(Pointer(P)^));
  914.   end;
  915.   FCacheIndex := Index;
  916.   FCacheFind := Result;
  917. end;
  918.  
  919. function TBookmarkList.GetCount: Longint;
  920. begin
  921.   Result := FList.Count;
  922. end;
  923.  
  924. function TBookmarkList.GetItem(Index: Longint): TBookmark;
  925. begin
  926.   Result := TBookmark(FList[Index]);
  927. end;
  928.  
  929. function TBookmarkList.IndexOf(const Item: TBookmark): Longint;
  930. begin
  931.   if not Find(Item, Result) then Result := -1;
  932. end;
  933.  
  934. procedure TBookmarkList.LinkActive(Value: Boolean);
  935. begin
  936.   Clear;
  937.   FLinkActive := Value;
  938. end;
  939.  
  940. procedure TBookmarkList.Delete;
  941. var
  942.   I: Longint;
  943. begin
  944.   with TRxDBGrid(FGrid).Datalink.Dataset do begin
  945.     DisableControls;
  946.     try
  947.       for I := FList.Count - 1 downto 0 do begin
  948.         if FList[I] <> nil then begin
  949.           GotoBookmark(TBookmark(FList[I]));
  950.           Delete;
  951.           StrDispose(FList[I]);
  952.         end;
  953.         FList.Delete(I);
  954.       end;
  955.       ListChanged;
  956.     finally
  957.       EnableControls;
  958.     end;
  959.   end;
  960. end;
  961.  
  962. function TBookmarkList.Refresh: Boolean;
  963. var
  964.   I: Longint;
  965. begin
  966.   Result := False;
  967.   with TRxDBGrid(FGrid).DataLink.Dataset do
  968.   try
  969.     CheckBrowseMode;
  970.     for I := FList.Count - 1 downto 0 do
  971.       if DbiSetToBookmark(Handle, Pointer(FList[I])) <> 0 then begin
  972.         Result := True;
  973.         StrDispose(FList[I]);
  974.         FList.Delete(I);
  975.       end;
  976.     ListChanged;
  977.   finally
  978.     UpdateCursorPos;
  979.     if Result then FGrid.Invalidate;
  980.   end;
  981. end;
  982.  
  983. procedure TBookmarkList.SetCurrentRowSelected(Value: Boolean);
  984. var
  985.   Index: Longint;
  986.   Current: TBookmark;
  987. begin
  988.   Current := CurrentRow;
  989.   Index := 0;
  990.   if (Current = nil) or (Find(Current, Index) = Value) then begin
  991.     if Current <> nil then StrDispose(Current);
  992.     Exit;
  993.   end;
  994.   if Value then begin
  995.     try
  996.       FList.Insert(Index, Current);
  997.     except
  998.       StrDispose(Current);
  999.       raise;
  1000.     end;
  1001.   end
  1002.   else begin
  1003.     if (Index < FList.Count) and (Index >= 0) then begin
  1004.       StrDispose(FList[Index]);
  1005.       FList.Delete(Index);
  1006.     end;
  1007.     StrDispose(Current);
  1008.   end;
  1009.   ListChanged;
  1010.   TRxDBGrid(FGrid).InvalidateRow(TRxDBGrid(FGrid).Row);
  1011.   GridInvalidateRow(TRxDBGrid(FGrid), TRxDBGrid(FGrid).Row);
  1012. end;
  1013.  
  1014. procedure TBookmarkList.ListChanged;
  1015. begin
  1016.   if FCache <> nil then StrDispose(FCache);
  1017.   FCache := nil;
  1018.   FCacheIndex := -1;
  1019. end;
  1020.  
  1021. {$ENDIF WIN32}
  1022.  
  1023. type
  1024.   TBookmarks = class(TBookmarkList);
  1025.  
  1026. { TRxDBGrid }
  1027.  
  1028. constructor TRxDBGrid.Create(AOwner: TComponent);
  1029. var
  1030.   Bmp: TBitmap;
  1031. begin
  1032.   inherited Create(AOwner);
  1033.   inherited DefaultDrawing := False;
  1034.   Options := DefRxGridOptions;
  1035.   Bmp := TBitmap.Create;
  1036.   try
  1037.     Bmp.Handle := LoadBitmap(hInstance, bmMultiDot);
  1038. {$IFDEF WIN32}
  1039.     FMsIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
  1040. {$ELSE}
  1041.     FMsIndicators := TImageList.Create(Bmp.Width, Bmp.Height);
  1042.     Bmp.Monochrome := False;
  1043. {$ENDIF}
  1044.     FMsIndicators.AddMasked(Bmp, clWhite);
  1045.     Bmp.Handle := LoadBitmap(hInstance, bmMultiArrow);
  1046. {$IFNDEF WIN32}
  1047.     Bmp.Monochrome := False;
  1048. {$ENDIF}
  1049.     FMsIndicators.AddMasked(Bmp, clWhite);
  1050.   finally
  1051.     Bmp.Free;
  1052.   end;
  1053.   FIniLink := TIniLink.Create;
  1054.   FIniLink.OnSave := IniSave;
  1055.   FIniLink.OnLoad := IniLoad;
  1056.   FShowGlyphs := True;
  1057.   FDefaultDrawing := True;
  1058.   FClearSelection := True;
  1059. {$IFNDEF WIN32}
  1060.   FBookmarks := TBookmarkList.Create(Self);
  1061.   FPressedCol := -1;
  1062. {$ENDIF}
  1063. end;
  1064.  
  1065. destructor TRxDBGrid.Destroy;
  1066. begin
  1067.   FIniLink.Free;
  1068. {$IFNDEF WIN32}
  1069.   if FSelectionAnchor <> nil then StrDispose(FSelectionAnchor);
  1070.   FSelectionAnchor := nil;
  1071.   FBookmarks.Free;
  1072.   FBookmarks := nil;
  1073. {$ENDIF}
  1074.   FMsIndicators.Free;
  1075.   inherited Destroy;
  1076. end;
  1077.  
  1078. function TRxDBGrid.GetImageIndex(Field: TField): Integer;
  1079. var
  1080.   AOnGetText: TFieldGetTextEvent;
  1081.   AOnSetText: TFieldSetTextEvent;
  1082. begin
  1083.   Result := -1;
  1084.   if FShowGlyphs and Assigned(Field) then begin
  1085.     if (not ReadOnly) and Field.CanModify then begin
  1086.       { Allow editing of memo fields if OnSetText and OnGetText
  1087.         events are assigned }
  1088.       AOnGetText := Field.OnGetText;
  1089.       AOnSetText := Field.OnSetText;
  1090.       if Assigned(AOnSetText) and Assigned(AOnGetText) then Exit;
  1091.     end;
  1092.     case Field.DataType of
  1093.       ftBytes, ftVarBytes, ftBlob: Result := Ord(gpBlob);
  1094.       ftMemo: Result := Ord(gpMemo);
  1095.       ftGraphic: Result := Ord(gpPicture);
  1096. {$IFDEF WIN32}
  1097.       ftTypedBinary: Result := Ord(gpBlob);
  1098.       ftFmtMemo: Result := Ord(gpMemo);
  1099.       ftParadoxOle, ftDBaseOle: Result := Ord(gpOle);
  1100. {$ENDIF}
  1101. {$IFDEF RX_D3}
  1102.       ftCursor: Result := Ord(gpData);
  1103. {$ENDIF}
  1104. {$IFDEF RX_D4}
  1105.       ftReference, ftDataSet: Result := Ord(gpData);
  1106. {$ENDIF}
  1107. {$IFDEF RX_D5}
  1108.       ftOraClob: Result := Ord(gpMemo);
  1109.       ftOraBlob: Result := Ord(gpBlob);
  1110. {$ENDIF}
  1111.     end;
  1112.   end;
  1113. end;
  1114.  
  1115. function TRxDBGrid.ActiveRowSelected: Boolean;
  1116. var
  1117. {$IFDEF WIN32}
  1118.   Index: Integer;
  1119. {$ELSE}
  1120.   Index: Longint;
  1121.   Bookmark: TBookmark;
  1122. {$ENDIF}
  1123. begin
  1124.   Result := False;
  1125.   if MultiSelect and Datalink.Active then begin
  1126. {$IFDEF WIN32}
  1127.     Result := SelectedRows.Find(Datalink.DataSet.Bookmark, Index);
  1128. {$ELSE}
  1129.     Bookmark := Datalink.Dataset.GetBookmark;
  1130.     try
  1131.       Result := SelectedRows.Find(Bookmark, Index);
  1132.     finally
  1133.       StrDispose(Bookmark);
  1134.     end;
  1135. {$ENDIF}
  1136.   end;
  1137. end;
  1138.  
  1139. function TRxDBGrid.HighlightCell(DataCol, DataRow: Integer;
  1140.   const Value: string; AState: TGridDrawState): Boolean;
  1141. begin
  1142.   Result := ActiveRowSelected;
  1143.   if not Result then
  1144.     Result := inherited HighlightCell(DataCol, DataRow, Value, AState);
  1145. end;
  1146.  
  1147. procedure TRxDBGrid.ToggleRowSelection;
  1148. begin
  1149.   if MultiSelect and Datalink.Active then
  1150.     with SelectedRows do CurrentRowSelected := not CurrentRowSelected;
  1151. end;
  1152.  
  1153. function TRxDBGrid.GetSelCount: Longint;
  1154. begin
  1155.   if MultiSelect and (Datalink <> nil) and Datalink.Active then
  1156.     Result := SelectedRows.Count
  1157.   else Result := 0;
  1158. end;
  1159.  
  1160. procedure TRxDBGrid.SelectAll;
  1161. var
  1162.   ABookmark: TBookmark;
  1163. begin
  1164.   if MultiSelect and DataLink.Active then begin
  1165.     with Datalink.Dataset do begin
  1166.       if (BOF and EOF) then Exit;
  1167.       DisableControls;
  1168.       try
  1169.         ABookmark := GetBookmark;
  1170.         try
  1171.           First;
  1172.           while not EOF do begin
  1173.             SelectedRows.CurrentRowSelected := True;
  1174.             Next;
  1175.           end;
  1176.         finally
  1177.           try
  1178.             GotoBookmark(ABookmark);
  1179.           except
  1180.           end;
  1181.           FreeBookmark(ABookmark);
  1182.         end;
  1183.       finally
  1184.         EnableControls;
  1185.       end;
  1186.     end;
  1187.   end;
  1188. end;
  1189.  
  1190. procedure TRxDBGrid.UnselectAll;
  1191. begin
  1192.   if MultiSelect then begin
  1193.     SelectedRows.Clear;
  1194.     FSelecting := False;
  1195.   end;
  1196. end;
  1197.  
  1198. procedure TRxDBGrid.GotoSelection(Index: Longint);
  1199. begin
  1200.   if MultiSelect and DataLink.Active and (Index < SelectedRows.Count) and
  1201.     (Index >= 0) then
  1202.     Datalink.DataSet.GotoBookmark(Pointer(SelectedRows[Index]));
  1203. end;
  1204.  
  1205. {$IFNDEF WIN32}
  1206. function TRxDBGrid.GetIndicatorOffset: Byte;
  1207. begin
  1208.   Result := 0;
  1209.   if dgIndicator in Options then Inc(Result);
  1210. end;
  1211. {$ENDIF WIN32}
  1212.  
  1213. procedure TRxDBGrid.LayoutChanged;
  1214. var
  1215.   ACol: Longint;
  1216. begin
  1217.   ACol := Col;
  1218.   inherited LayoutChanged;
  1219.   if Datalink.Active and (FixedCols > 0) then
  1220. {$IFDEF RX_D4}
  1221.     Col := Min(Max(CalcLeftColumn, ACol), ColCount - 1);
  1222. {$ELSE}
  1223.     Col := Min(Max(inherited FixedCols, ACol), ColCount - 1);
  1224. {$ENDIF}
  1225. end;
  1226.  
  1227. {$IFDEF WIN32}
  1228. procedure TRxDBGrid.ColWidthsChanged;
  1229. var
  1230.   ACol: Longint;
  1231. begin
  1232.   ACol := Col;
  1233.   inherited ColWidthsChanged;
  1234.   if Datalink.Active and (FixedCols > 0) then
  1235. {$IFDEF RX_D4}
  1236.     Col := Min(Max(CalcLeftColumn, ACol), ColCount - 1);
  1237. {$ELSE}
  1238.     Col := Min(Max(inherited FixedCols, ACol), ColCount - 1);
  1239. {$ENDIF}
  1240. end;
  1241. {$ENDIF}
  1242.  
  1243. function TRxDBGrid.CreateEditor: TInplaceEdit;
  1244. begin
  1245.   Result := inherited CreateEditor;
  1246.   TEdit(Result).OnChange := EditChanged;
  1247. end;
  1248.  
  1249. function TRxDBGrid.GetTitleOffset: Byte;
  1250. {$IFDEF RX_D4}
  1251. var
  1252.   I, J: Integer;
  1253. {$ENDIF}
  1254. begin
  1255.   Result := 0;
  1256.   if dgTitles in Options then begin
  1257.     Result := 1;
  1258. {$IFDEF RX_D4}
  1259.     if (Datalink <> nil) and (Datalink.Dataset <> nil) and
  1260.       Datalink.Dataset.ObjectView then
  1261.     begin
  1262.       for I := 0 to Columns.Count - 1 do begin
  1263.         if Columns[I].Showing then begin
  1264.           J := Columns[I].Depth;
  1265.           if J >= Result then Result := J + 1;
  1266.         end;
  1267.       end;
  1268.     end;
  1269. {$ENDIF}
  1270.   end;
  1271. end;
  1272.  
  1273. procedure TRxDBGrid.SetColumnAttributes;
  1274. begin
  1275.   inherited SetColumnAttributes;
  1276.   SetFixedCols(FFixedCols);
  1277. end;
  1278.  
  1279. procedure TRxDBGrid.SetFixedCols(Value: Integer);
  1280. var
  1281.   FixCount, I: Integer;
  1282. begin
  1283.   FixCount := Max(Value, 0) + IndicatorOffset;
  1284.   if DataLink.Active and not (csLoading in ComponentState) and
  1285.     (ColCount > IndicatorOffset + 1) then
  1286.   begin
  1287.     FixCount := Min(FixCount, ColCount - 1);
  1288.     inherited FixedCols := FixCount;
  1289.     for I := 1 to Min(FixedCols, ColCount - 1) do
  1290.       TabStops[I] := False;
  1291.   end;
  1292.   FFixedCols := FixCount - IndicatorOffset;
  1293. end;
  1294.  
  1295. function TRxDBGrid.GetFixedCols: Integer;
  1296. begin
  1297.   if DataLink.Active then Result := inherited FixedCols - IndicatorOffset
  1298.   else Result := FFixedCols;
  1299. end;
  1300.  
  1301. {$IFDEF RX_D4}
  1302. function TRxDBGrid.CalcLeftColumn: Integer;
  1303. begin
  1304.   Result := FixedCols + IndicatorOffset;
  1305.   while (Result < ColCount) and (ColWidths[Result] <= 0) do
  1306.     Inc(Result);
  1307. end;
  1308. {$ENDIF}
  1309.  
  1310. procedure TRxDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
  1311. var
  1312.   KeyDownEvent: TKeyEvent;
  1313.  
  1314.   procedure ClearSelections;
  1315.   begin
  1316.     if FMultiSelect then begin
  1317.       if FClearSelection then SelectedRows.Clear;
  1318.       FSelecting := False;
  1319.     end;
  1320.   end;
  1321.  
  1322.   procedure DoSelection(Select: Boolean; Direction: Integer);
  1323.   var
  1324.     AddAfter: Boolean;
  1325. {$IFNDEF WIN32}
  1326.     CurRow: TBookmark;
  1327. {$ENDIF}
  1328.   begin
  1329.     AddAfter := False;
  1330. {$IFDEF WIN32}
  1331.     BeginUpdate;
  1332.     try
  1333. {$ENDIF}
  1334.       if MultiSelect and DataLink.Active then
  1335.         if Select and (ssShift in Shift) then begin
  1336.           if not FSelecting then begin
  1337. {$IFNDEF WIN32}
  1338.             if FSelectionAnchor <> nil then StrDispose(FSelectionAnchor);
  1339. {$ENDIF}
  1340.             FSelectionAnchor := TBookmarks(SelectedRows).CurrentRow;
  1341.             SelectedRows.CurrentRowSelected := True;
  1342.             FSelecting := True;
  1343.             AddAfter := True;
  1344.           end
  1345.           else with TBookmarks(SelectedRows) do begin
  1346. {$IFDEF WIN32}
  1347.             AddAfter := Compare(CurrentRow, FSelectionAnchor) <> -Direction;
  1348. {$ELSE}
  1349.             CurRow := CurrentRow;
  1350.             try
  1351.               AddAfter := Compare(CurRow, FSelectionAnchor) <> -Direction;
  1352.             finally
  1353.               StrDispose(CurRow);
  1354.             end;
  1355. {$ENDIF}
  1356.             if not AddAfter then CurrentRowSelected := False;
  1357.           end
  1358.         end
  1359.         else ClearSelections;
  1360.       if Direction <> 0 then Datalink.DataSet.MoveBy(Direction);
  1361.       if AddAfter then SelectedRows.CurrentRowSelected := True;
  1362. {$IFDEF WIN32}
  1363.     finally
  1364.       EndUpdate;
  1365.     end;
  1366. {$ENDIF}
  1367.   end;
  1368.  
  1369.   procedure NextRow(Select: Boolean);
  1370.   begin
  1371.     with Datalink.Dataset do begin
  1372.       DoSelection(Select, 1);
  1373.       if EOF and CanModify and (not ReadOnly) and (dgEditing in Options) then
  1374.         Append;
  1375.     end;
  1376.   end;
  1377.  
  1378.   procedure PriorRow(Select: Boolean);
  1379.   begin
  1380.     DoSelection(Select, -1);
  1381.   end;
  1382.  
  1383.   procedure CheckTab(GoForward: Boolean);
  1384.   var
  1385.     ACol, Original: Integer;
  1386.   begin
  1387.     ACol := Col;
  1388.     Original := ACol;
  1389.     if MultiSelect and DataLink.Active then
  1390.       while True do begin
  1391.         if GoForward then Inc(ACol) else Dec(ACol);
  1392.         if ACol >= ColCount then begin
  1393.           ClearSelections;
  1394.           ACol := IndicatorOffset;
  1395.         end
  1396.         else if ACol < IndicatorOffset then begin
  1397.           ClearSelections;
  1398.           ACol := ColCount;
  1399.         end;
  1400.         if ACol = Original then Exit;
  1401.         if TabStops[ACol] then Exit;
  1402.       end;
  1403.   end;
  1404.  
  1405.   function DeletePrompt: Boolean;
  1406.   var
  1407.     S: string;
  1408.   begin
  1409.     if (SelectedRows.Count > 1) then
  1410. {$IFDEF WIN32}
  1411.       S := ResStr(SDeleteMultipleRecordsQuestion)
  1412. {$ELSE}
  1413.       S := LoadStr(SDeleteMultipleRecords)
  1414. {$ENDIF}
  1415.     else S := ResStr(SDeleteRecordQuestion);
  1416.     Result := not (dgConfirmDelete in Options) or
  1417.       (MessageDlg(S, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  1418.   end;
  1419.  
  1420. begin
  1421.   KeyDownEvent := OnKeyDown;
  1422.   if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  1423.   if not Datalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
  1424.   with Datalink.DataSet do
  1425.     if ssCtrl in Shift then begin
  1426.       if (Key in [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END]) then
  1427.         ClearSelections;
  1428.       case Key of
  1429.         VK_LEFT:
  1430.           if FixedCols > 0 then begin
  1431. {$IFDEF RX_D4}
  1432.             SelectedIndex := CalcLeftColumn - IndicatorOffset;
  1433. {$ELSE}
  1434.             SelectedIndex := FixedCols;
  1435. {$ENDIF}
  1436.             Exit;
  1437.           end;
  1438.         VK_DELETE:
  1439.           if not ReadOnly and CanModify and not
  1440.             IsDataSetEmpty(Datalink.DataSet) then
  1441.           begin
  1442.             if DeletePrompt then begin
  1443.               if SelectedRows.Count > 0 then SelectedRows.Delete
  1444.               else Delete;
  1445.             end;
  1446.             Exit;
  1447.           end;
  1448.       end
  1449.     end
  1450.     else begin
  1451.       case Key of
  1452.         VK_LEFT:
  1453.           if (FixedCols > 0) and not (dgRowSelect in Options) then begin
  1454. {$IFDEF RX_D4}
  1455.             if SelectedIndex <= CalcLeftColumn - IndicatorOffset then
  1456.               Exit;
  1457. {$ELSE}
  1458.             if SelectedIndex <= FFixedCols then Exit;
  1459. {$ENDIF}
  1460.           end;
  1461.         VK_HOME:
  1462.           if (FixedCols > 0) and (ColCount <> IndicatorOffset + 1) and
  1463.             not (dgRowSelect in Options) then
  1464.           begin
  1465. {$IFDEF RX_D4}
  1466.             SelectedIndex := CalcLeftColumn - IndicatorOffset;
  1467. {$ELSE}
  1468.             SelectedIndex := FixedCols;
  1469. {$ENDIF}
  1470.             Exit;
  1471.           end;
  1472.       end;
  1473.       if (Datalink.DataSet.State = dsBrowse) then begin
  1474.         case Key of
  1475.           VK_UP:
  1476.             begin
  1477.               PriorRow(True); Exit;
  1478.             end;
  1479.           VK_DOWN:
  1480.             begin
  1481.               NextRow(True); Exit;
  1482.             end;
  1483.         end;
  1484.       end;
  1485.       if ((Key in [VK_LEFT, VK_RIGHT]) and (dgRowSelect in Options)) or
  1486.         ((Key in [VK_HOME, VK_END]) and ((ColCount = IndicatorOffset + 1)
  1487.           or (dgRowSelect in Options))) or (Key in [VK_ESCAPE, VK_NEXT,
  1488.           VK_PRIOR]) or ((Key = VK_INSERT) and (CanModify and
  1489.           (not ReadOnly) and (dgEditing in Options))) then
  1490.         ClearSelections
  1491.       else if ((Key = VK_TAB) and not (ssAlt in Shift)) then
  1492.         CheckTab(not (ssShift in Shift));
  1493.     end;
  1494.   OnKeyDown := nil;
  1495.   try
  1496.     inherited KeyDown(Key, Shift);
  1497.   finally
  1498.     OnKeyDown := KeyDownEvent;
  1499.   end;
  1500. end;
  1501.  
  1502. procedure TRxDBGrid.SetShowGlyphs(Value: Boolean);
  1503. begin
  1504.   if FShowGlyphs <> Value then begin
  1505.     FShowGlyphs := Value;
  1506.     Invalidate;
  1507.   end;
  1508. end;
  1509.  
  1510. procedure TRxDBGrid.SetRowsHeight(Value: Integer);
  1511. begin
  1512.   if not (csDesigning in ComponentState) and (DefaultRowHeight <> Value) then
  1513.   begin
  1514.     DefaultRowHeight := Value;
  1515.     if dgTitles in Options then RowHeights[0] := Value + 2;
  1516.     if HandleAllocated then
  1517.       Perform(WM_SIZE, SIZE_RESTORED, MakeLong(ClientWidth, ClientHeight));
  1518.   end;
  1519. end;
  1520.  
  1521. function TRxDBGrid.GetRowsHeight: Integer;
  1522. begin
  1523.   Result := DefaultRowHeight;
  1524. end;
  1525.  
  1526. {$IFDEF WIN32}
  1527.  
  1528. function TRxDBGrid.GetOptions: TDBGridOptions;
  1529. begin
  1530.   Result := inherited Options;
  1531.   if FMultiSelect then Result := Result + [dgMultiSelect]
  1532.   else Result := Result - [dgMultiSelect];
  1533. end;
  1534.  
  1535. procedure TRxDBGrid.SetOptions(Value: TDBGridOptions);
  1536. var
  1537.   NewOptions: TGridOptions;
  1538. begin
  1539.   inherited Options := Value - [dgMultiSelect];
  1540.   NewOptions := TDrawGrid(Self).Options;
  1541.   {
  1542.   if FTitleButtons then begin
  1543.     TDrawGrid(Self).Options := NewOptions + [goFixedHorzLine, goFixedVertLine];
  1544.   end else
  1545.   }
  1546.   begin
  1547.     if not (dgColLines in Value) then
  1548.       NewOptions := NewOptions - [goFixedVertLine];
  1549.     if not (dgRowLines in Value) then
  1550.       NewOptions := NewOptions - [goFixedHorzLine];
  1551.     TDrawGrid(Self).Options := NewOptions;
  1552.   end;
  1553.   SetMultiSelect(dgMultiSelect in Value);
  1554. end;
  1555.  
  1556. {$ELSE}
  1557.  
  1558. procedure TRxDBGrid.LinkActive(Value: Boolean);
  1559. begin
  1560.   SelectedRows.LinkActive(Value);
  1561.   inherited LinkActive(Value);
  1562. end;
  1563.  
  1564. function TRxDBGrid.GetFixedColor: TColor;
  1565. begin
  1566.   Result := inherited TitleColor;
  1567. end;
  1568.  
  1569. procedure TRxDBGrid.SetFixedColor(Value: TColor);
  1570. begin
  1571.   if FixedColor <> Value then begin
  1572.     inherited TitleColor := Value;
  1573.     inherited FixedColor := Value;
  1574.     Invalidate;
  1575.   end;
  1576. end;
  1577.  
  1578. procedure TRxDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  1579. begin
  1580.   inherited ColumnMoved(FromIndex, ToIndex);
  1581.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  1582. end;
  1583.  
  1584. {$ENDIF WIN32}
  1585.  
  1586. procedure TRxDBGrid.Paint;
  1587. begin
  1588.   inherited Paint;
  1589.   if not (csDesigning in ComponentState) and
  1590.     (dgRowSelect in Options) and DefaultDrawing and Focused then
  1591.   begin
  1592.     Canvas.Font.Color := clWindowText;
  1593.     with Selection do
  1594.       DrawFocusRect(Canvas.Handle, BoxRect(Left, Top, Right, Bottom));
  1595.   end;
  1596. end;
  1597.  
  1598. procedure TRxDBGrid.SetTitleButtons(Value: Boolean);
  1599. begin
  1600.   if FTitleButtons <> Value then begin
  1601.     FTitleButtons := Value;
  1602.     Invalidate;
  1603. {$IFDEF WIN32}
  1604.     SetOptions(Options);
  1605. {$ENDIF}
  1606.   end;
  1607. end;
  1608.  
  1609. procedure TRxDBGrid.SetMultiSelect(Value: Boolean);
  1610. begin
  1611.   if FMultiSelect <> Value then begin
  1612.     FMultiSelect := Value;
  1613.     if not Value then SelectedRows.Clear;
  1614.   end;
  1615. end;
  1616.  
  1617. function TRxDBGrid.GetStorage: TFormPlacement;
  1618. begin
  1619.   Result := FIniLink.Storage;
  1620. end;
  1621.  
  1622. procedure TRxDBGrid.SetStorage(Value: TFormPlacement);
  1623. begin
  1624.   FIniLink.Storage := Value;
  1625. end;
  1626.  
  1627. function TRxDBGrid.AcquireFocus: Boolean;
  1628. begin
  1629.   Result := True;
  1630.   if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
  1631.   begin
  1632.     SetFocus;
  1633.     Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
  1634.   end;
  1635. end;
  1636.  
  1637. function TRxDBGrid.CanEditShow: Boolean;
  1638. var
  1639.   F: TField;
  1640. begin
  1641.   Result := inherited CanEditShow;
  1642.   F := nil;
  1643.   if Result and (Datalink <> nil) and Datalink.Active and (FieldCount > 0) and
  1644.     (SelectedIndex < FieldCount) and (SelectedIndex >= 0) and
  1645.     (FieldCount <= DataSource.DataSet.FieldCount) then
  1646.   begin
  1647.     F := Fields[SelectedIndex];
  1648.     if F <> nil then Result := GetImageIndex(F) < 0;
  1649.   end;
  1650.   if Result and Assigned(FOnShowEditor) then
  1651.     FOnShowEditor(Self, F, Result);
  1652. end;
  1653.  
  1654. procedure TRxDBGrid.GetCellProps(Field: TField; AFont: TFont;
  1655.   var Background: TColor; Highlight: Boolean);
  1656. var
  1657.   AColor, ABack: TColor;
  1658. begin
  1659.   if Assigned(FOnGetCellParams) then
  1660.     FOnGetCellParams(Self, Field, AFont, Background, Highlight)
  1661.   else if Assigned(FOnGetCellProps) then begin
  1662.     if Highlight then begin
  1663.       AColor := AFont.Color;
  1664.       FOnGetCellProps(Self, Field, AFont, ABack);
  1665.       AFont.Color := AColor;
  1666.     end
  1667.     else FOnGetCellProps(Self, Field, AFont, Background);
  1668.   end;
  1669. end;
  1670.  
  1671. procedure TRxDBGrid.DoTitleClick(ACol: Longint; AField: TField);
  1672. begin
  1673.   if Assigned(FOnTitleBtnClick) then FOnTitleBtnClick(Self, ACol, AField);
  1674. end;
  1675.  
  1676. procedure TRxDBGrid.CheckTitleButton(ACol, ARow: Longint; var Enabled: Boolean);
  1677. var
  1678.   Field: TField;
  1679. begin
  1680.   if (ACol >= 0) and (ACol < {$IFDEF WIN32} Columns.Count {$ELSE}
  1681.     FieldCount {$ENDIF}) then
  1682.   begin
  1683.     if Assigned(FOnCheckButton) then begin
  1684. {$IFDEF WIN32}
  1685.       Field := Columns[ACol].Field;
  1686.   {$IFDEF RX_D4}
  1687.       if ColumnAtDepth(Columns[ACol], ARow) <> nil then
  1688.         Field := ColumnAtDepth(Columns[ACol], ARow).Field;
  1689.   {$ENDIF}
  1690. {$ELSE}
  1691.       Field := Fields[ACol];
  1692. {$ENDIF}
  1693.       FOnCheckButton(Self, ACol, Field, Enabled);
  1694.     end;
  1695.   end
  1696.   else Enabled := False;
  1697. end;
  1698.  
  1699. procedure TRxDBGrid.DisableScroll;
  1700. begin
  1701.   Inc(FDisableCount);
  1702. end;
  1703.  
  1704. type
  1705.   THackLink = class(TGridDataLink);
  1706.  
  1707. procedure TRxDBGrid.EnableScroll;
  1708. begin
  1709.   if FDisableCount <> 0 then begin
  1710.     Dec(FDisableCount);
  1711.     if FDisableCount = 0 then
  1712.       THackLink(DataLink).DataSetScrolled(0);
  1713.   end;
  1714. end;
  1715.  
  1716. function TRxDBGrid.ScrollDisabled: Boolean;
  1717. begin
  1718.   Result := FDisableCount <> 0;
  1719. end;
  1720.  
  1721. procedure TRxDBGrid.Scroll(Distance: Integer);
  1722. {$IFNDEF RX_D3}
  1723. var
  1724.   IndicatorRect: TRect;
  1725. {$ENDIF}
  1726. begin
  1727.   if FDisableCount = 0 then begin
  1728.     inherited Scroll(Distance);
  1729. {$IFNDEF RX_D3}
  1730.     if (dgIndicator in Options) and HandleAllocated and MultiSelect then
  1731.     begin
  1732.       IndicatorRect := BoxRect(0, 0, 0, RowCount - 1);
  1733.       InvalidateRect(Handle, @IndicatorRect, False);
  1734.     end;
  1735. {$ENDIF}
  1736.   end;
  1737. end;
  1738.  
  1739. {$IFDEF RX_D4}
  1740.  
  1741. function TRxDBGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
  1742. begin
  1743.   Result := False;
  1744.   if Assigned(OnMouseWheelDown) then
  1745.     OnMouseWheelDown(Self, Shift, MousePos, Result);
  1746.   if not Result then begin
  1747.     if not AcquireFocus then Exit;
  1748.     if Datalink.Active then begin
  1749.       Result := Datalink.DataSet.MoveBy(1) <> 0;
  1750.     end;
  1751.   end;
  1752. end;
  1753.  
  1754. function TRxDBGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
  1755. begin
  1756.   Result := False;
  1757.   if Assigned(OnMouseWheelUp) then
  1758.     OnMouseWheelUp(Self, Shift, MousePos, Result);
  1759.   if not Result then begin
  1760.     if not AcquireFocus then Exit;
  1761.     if Datalink.Active then begin
  1762.       Result := Datalink.DataSet.MoveBy(-1) <> 0;
  1763.     end;
  1764.   end;
  1765. end;
  1766.  
  1767. {$ENDIF RX_D4}
  1768.  
  1769. procedure TRxDBGrid.EditChanged(Sender: TObject);
  1770. begin
  1771.   if Assigned(FOnEditChange) then FOnEditChange(Self);
  1772. end;
  1773.  
  1774. procedure TRxDBGrid.TopLeftChanged;
  1775. begin
  1776.   if (dgRowSelect in Options) and DefaultDrawing then
  1777.     GridInvalidateRow(Self, Self.Row);
  1778.   inherited TopLeftChanged;
  1779.   if FTracking then StopTracking;
  1780.   if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
  1781. end;
  1782.  
  1783. procedure TRxDBGrid.StopTracking;
  1784. begin
  1785.   if FTracking then begin
  1786.     TrackButton(-1, -1);
  1787.     FTracking := False;
  1788.     MouseCapture := False;
  1789.   end;
  1790. end;
  1791.  
  1792. procedure TRxDBGrid.TrackButton(X, Y: Integer);
  1793. var
  1794.   Cell: TGridCoord;
  1795.   NewPressed: Boolean;
  1796.   I, Offset: Integer;
  1797. begin
  1798.   Cell := MouseCoord(X, Y);
  1799.   Offset := TitleOffset;
  1800.   NewPressed := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y)) and
  1801.     (FPressedCol = {$IFDEF WIN32} GetMasterColumn(Cell.X, Cell.Y) {$ELSE}
  1802.     Cell.X {$ENDIF}) and (Cell.Y < Offset);
  1803.   if FPressed <> NewPressed then begin
  1804.     FPressed := NewPressed;
  1805.     for I := 0 to Offset - 1 do
  1806.       GridInvalidateRow(Self, I);
  1807.   end;
  1808. end;
  1809.  
  1810. procedure TRxDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1811.   X, Y: Integer);
  1812. var
  1813.   Cell: TGridCoord;
  1814.   MouseDownEvent: TMouseEvent;
  1815.   EnableClick: Boolean;
  1816. begin
  1817.   if not AcquireFocus then Exit;
  1818.   if (ssDouble in Shift) and (Button = mbLeft) then begin
  1819.     DblClick;
  1820.     Exit;
  1821.   end;
  1822.   if Sizing(X, Y) then
  1823.     inherited MouseDown(Button, Shift, X, Y)
  1824.   else begin
  1825.     Cell := MouseCoord(X, Y);
  1826. {$IFDEF RX_D4}
  1827.     if (DragKind = dkDock) and (Cell.X < IndicatorOffset) and
  1828.       (Cell.Y < TitleOffset) and (not (csDesigning in ComponentState)) then
  1829.     begin
  1830.       BeginDrag(False);
  1831.       Exit;
  1832.     end;
  1833. {$ENDIF}
  1834.     if FTitleButtons and (Datalink <> nil) and Datalink.Active and
  1835.       (Cell.Y < TitleOffset) and (Cell.X >= IndicatorOffset) and
  1836.       not (csDesigning in ComponentState) then
  1837.     begin
  1838.       if (dgColumnResize in Options) and (Button = mbRight) then begin
  1839.         Button := mbLeft;
  1840.         FSwapButtons := True;
  1841.         MouseCapture := True;
  1842.       end
  1843.       else if Button = mbLeft then begin
  1844.         EnableClick := True;
  1845.         CheckTitleButton(Cell.X - IndicatorOffset, Cell.Y, EnableClick);
  1846.         if EnableClick then begin
  1847.           MouseCapture := True;
  1848.           FTracking := True;
  1849. {$IFDEF WIN32}
  1850.           FPressedCol := GetMasterColumn(Cell.X, Cell.Y);
  1851. {$ELSE}
  1852.           FPressedCol := Cell.X;
  1853. {$ENDIF}
  1854.           TrackButton(X, Y);
  1855.         end else Beep;
  1856.         Exit;
  1857.       end;
  1858.     end;
  1859.     if (Cell.X < FixedCols + IndicatorOffset) and Datalink.Active then begin
  1860.       if (dgIndicator in Options) then
  1861.         inherited MouseDown(Button, Shift, 1, Y)
  1862.       else if Cell.Y >= TitleOffset then
  1863.         if Cell.Y - Row <> 0 then Datalink.Dataset.MoveBy(Cell.Y - Row);
  1864.     end
  1865.     else inherited MouseDown(Button, Shift, X, Y);
  1866.     MouseDownEvent := OnMouseDown;
  1867.     if Assigned(MouseDownEvent) then MouseDownEvent(Self, Button, Shift, X, Y);
  1868.     if not (((csDesigning in ComponentState) or (dgColumnResize in Options)) and
  1869.       (Cell.Y < TitleOffset)) and (Button = mbLeft) then
  1870.     begin
  1871.       if MultiSelect and Datalink.Active then
  1872.         with SelectedRows do begin
  1873.           FSelecting := False;
  1874.           if ssCtrl in Shift then
  1875.             CurrentRowSelected := not CurrentRowSelected
  1876.           else begin
  1877.             Clear;
  1878.             if FClearSelection then CurrentRowSelected := True;
  1879.           end;
  1880.         end;
  1881.     end;
  1882.   end;
  1883. end;
  1884.  
  1885. procedure TRxDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
  1886. begin
  1887.   if FTracking then TrackButton(X, Y);
  1888.   inherited MouseMove(Shift, X, Y);
  1889. end;
  1890.  
  1891. procedure TRxDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1892.   X, Y: Integer);
  1893. var
  1894.   Cell: TGridCoord;
  1895.   ACol: Longint;
  1896.   DoClick: Boolean;
  1897. begin
  1898.   if FTracking and {$IFDEF WIN32} (FPressedCol <> nil) {$ELSE}
  1899.     (FPressedCol >= 0) {$ENDIF} then
  1900.   begin
  1901.     Cell := MouseCoord(X, Y);
  1902.     DoClick := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y))
  1903.       and (Cell.Y < TitleOffset) and
  1904. {$IFDEF WIN32}
  1905.       (FPressedCol = GetMasterColumn(Cell.X, Cell.Y));
  1906. {$ELSE}
  1907.       (Cell.X = FPressedCol);
  1908. {$ENDIF}
  1909.     StopTracking;
  1910.     if DoClick then begin
  1911.       ACol := Cell.X;
  1912.       if (dgIndicator in Options) then Dec(ACol);
  1913.       if (DataLink <> nil) and DataLink.Active and (ACol >= 0) and
  1914.         (ACol < {$IFDEF WIN32} Columns.Count {$ELSE} FieldCount {$ENDIF}) then
  1915.       begin
  1916. {$IFDEF WIN32}
  1917.         DoTitleClick(FPressedCol.Index, FPressedCol.Field);
  1918. {$ELSE}
  1919.         DoTitleClick(ACol, Fields[ACol]);
  1920. {$ENDIF}
  1921.       end;
  1922.     end;
  1923.   end
  1924.   else if FSwapButtons then begin
  1925.     FSwapButtons := False;
  1926.     MouseCapture := False;
  1927.     if Button = mbRight then Button := mbLeft;
  1928.   end;
  1929.   inherited MouseUp(Button, Shift, X, Y);
  1930. end;
  1931.  
  1932. {$IFDEF WIN32}
  1933. procedure TRxDBGrid.WMRButtonUp(var Message: TWMMouse);
  1934. begin
  1935.   if not (FGridState in [gsColMoving, gsRowMoving]) then
  1936.     inherited
  1937.   else if not (csNoStdEvents in ControlStyle) then
  1938.     with Message do MouseUp(mbRight, KeysToShiftState(Keys), XPos, YPos);
  1939. end;
  1940. {$ENDIF}
  1941.  
  1942. procedure TRxDBGrid.WMCancelMode(var Message: TMessage);
  1943. begin
  1944.   StopTracking;
  1945.   inherited;
  1946. end;
  1947.  
  1948. type
  1949.   THack = class(TWinControl);
  1950.  
  1951. procedure TRxDBGrid.WMChar(var Msg: TWMChar);
  1952.  
  1953.   function DoKeyPress(var Msg: TWMChar): Boolean;
  1954.   var
  1955.     Form: TCustomForm;
  1956.     Ch: Char;
  1957.   begin
  1958.     Result := True;
  1959.     Form := GetParentForm(Self);
  1960.     if (Form <> nil) and TForm(Form).KeyPreview and
  1961.       THack(Form).DoKeyPress(Msg) then Exit;
  1962.     with Msg do begin
  1963.       if Assigned(FOnKeyPress) then begin
  1964.         Ch := Char(CharCode);
  1965.         FOnKeyPress(Self, Ch);
  1966.         CharCode := Word(Ch);
  1967.       end;
  1968.       if Char(CharCode) = #0 then Exit;
  1969.     end;
  1970.     Result := False;
  1971.   end;
  1972.  
  1973. begin
  1974.   if EditorMode or not DoKeyPress(Msg) then inherited;
  1975. end;
  1976.  
  1977. procedure TRxDBGrid.KeyPress(var Key: Char);
  1978. begin
  1979.   if EditorMode then inherited OnKeyPress := FOnKeyPress;
  1980.   try
  1981.     inherited KeyPress(Key);
  1982.   finally
  1983.     inherited OnKeyPress := nil;
  1984.   end;
  1985. end;
  1986.  
  1987. procedure TRxDBGrid.DefaultDataCellDraw(const Rect: TRect; Field: TField;
  1988.   State: TGridDrawState);
  1989. begin
  1990.   DefaultDrawDataCell(Rect, Field, State);
  1991. end;
  1992.  
  1993. {$IFDEF WIN32}
  1994. function TRxDBGrid.GetMasterColumn(ACol, ARow: Longint): TColumn;
  1995. begin
  1996.   if (dgIndicator in Options) then Dec(ACol, IndicatorOffset);
  1997.   if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
  1998.     (ACol < Columns.Count) then
  1999.   begin
  2000.     Result := Columns[ACol];
  2001. {$IFDEF RX_D4}
  2002.     Result := ColumnAtDepth(Result, ARow);
  2003. {$ENDIF}
  2004.   end
  2005.   else Result := nil;
  2006. end;
  2007. {$ENDIF}
  2008.  
  2009. procedure TRxDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  2010.   AState: TGridDrawState);
  2011.  
  2012. {$IFDEF RX_D4}
  2013.   function CalcTitleRect(Col: TColumn; ARow: Integer; var MasterCol: TColumn): TRect;
  2014.     { copied from Inprise's DbGrids.pas }
  2015.   var
  2016.     I,J: Integer;
  2017.     InBiDiMode: Boolean;
  2018.     DrawInfo: TGridDrawInfo;
  2019.   begin
  2020.     MasterCol := ColumnAtDepth(Col, ARow);
  2021.     if MasterCol = nil then Exit;
  2022.     I := DataToRawColumn(MasterCol.Index);
  2023.     if I >= LeftCol then J := MasterCol.Depth
  2024.     else begin
  2025.       if (FixedCols > 0) and (MasterCol.Index < FixedCols) then begin
  2026.         J := MasterCol.Depth;
  2027.       end
  2028.       else begin
  2029.         I := LeftCol;
  2030.         if Col.Depth > ARow then J := ARow
  2031.         else J := Col.Depth;
  2032.       end;
  2033.     end;
  2034.     Result := CellRect(I, J);
  2035.     InBiDiMode := UseRightToLeftAlignment and (Canvas.CanvasOrientation = coLeftToRight);
  2036.     for I := Col.Index to Columns.Count - 1 do begin
  2037.       if ColumnAtDepth(Columns[I], ARow) <> MasterCol then Break;
  2038.       if not InBiDiMode then begin
  2039.         J := CellRect(DataToRawColumn(I), ARow).Right;
  2040.         if J = 0 then Break;
  2041.         Result.Right := Max(Result.Right, J);
  2042.       end
  2043.       else begin
  2044.         J := CellRect(DataToRawColumn(I), ARow).Left;
  2045.         if J >= ClientWidth then Break;
  2046.         Result.Left := J;
  2047.       end;
  2048.     end;
  2049.     J := Col.Depth;
  2050.     if (J <= ARow) and (J < FixedRows - 1) then begin
  2051.       CalcFixedInfo(DrawInfo);
  2052.       Result.Bottom := DrawInfo.Vert.FixedBoundary -
  2053.         DrawInfo.Vert.EffectiveLineWidth;
  2054.     end;
  2055.   end;
  2056.  
  2057.   procedure DrawExpandBtn(var TitleRect, TextRect: TRect; InBiDiMode: Boolean;
  2058.     Expanded: Boolean); { copied from Inprise's DbGrids.pas }
  2059.   const
  2060.     ScrollArrows: array [Boolean, Boolean] of Integer =
  2061.       ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
  2062.   var
  2063.     ButtonRect: TRect;
  2064.     I: Integer;
  2065.   begin
  2066.     I := GetSystemMetrics(SM_CXHSCROLL);
  2067.     if ((TextRect.Right - TextRect.Left) > I) then begin
  2068.       Dec(TextRect.Right, I);
  2069.       ButtonRect := TitleRect;
  2070.       ButtonRect.Left := TextRect.Right;
  2071.       I := SaveDC(Canvas.Handle);
  2072.       try
  2073.         Canvas.FillRect(ButtonRect);
  2074.         InflateRect(ButtonRect, -1, -1);
  2075.         with ButtonRect do
  2076.           IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  2077.         InflateRect(ButtonRect, 1, 1);
  2078.         { DrawFrameControl doesn't draw properly when orienatation has changed.
  2079.           It draws as ExtTextOut does. }
  2080.         if InBiDiMode then { stretch the arrows box }
  2081.           Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
  2082.         DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
  2083.           ScrollArrows[InBiDiMode, Expanded] or DFCS_FLAT);
  2084.       finally
  2085.         RestoreDC(Canvas.Handle, I);
  2086.       end;
  2087.       TitleRect.Right := ButtonRect.Left;
  2088.     end;
  2089.   end;
  2090. {$ENDIF RX_D4}
  2091.  
  2092. var
  2093.   FrameOffs: Byte;
  2094.   BackColor: TColor;
  2095.   SortMarker: TSortMarker;
  2096.   Indicator, ALeft: Integer;
  2097.   Down: Boolean;
  2098.   Bmp: TBitmap;
  2099.   SavePen: TColor;
  2100.   OldActive: Longint;
  2101.   MultiSelected: Boolean;
  2102.   FixRect: TRect;
  2103.   TitleRect, TextRect: TRect;
  2104.   AField: TField;
  2105. {$IFDEF RX_D4}
  2106.   MasterCol: TColumn;
  2107.   InBiDiMode: Boolean;
  2108. {$ENDIF}
  2109. {$IFDEF WIN32}
  2110.   DrawColumn: TColumn;
  2111. const
  2112.   EdgeFlag: array[Boolean] of UINT = (BDR_RAISEDINNER, BDR_SUNKENINNER);
  2113. {$ENDIF}
  2114. begin
  2115.   inherited DrawCell(ACol, ARow, ARect, AState);
  2116. {$IFDEF RX_D4}
  2117.   InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
  2118. {$ENDIF}
  2119.   if (dgIndicator in Options) and (ACol = 0) and (ARow - TitleOffset >= 0)
  2120.     and MultiSelect and (DataLink <> nil) and DataLink.Active and
  2121.     (Datalink.DataSet.State = dsBrowse) then
  2122.   begin { draw multiselect indicators if needed }
  2123.     FixRect := ARect;
  2124.     if ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines]) then
  2125.     begin
  2126.       InflateRect(FixRect, -1, -1);
  2127.       FrameOffs := 1;
  2128.     end
  2129.     else FrameOffs := 2;
  2130.     OldActive := DataLink.ActiveRecord;
  2131.     try
  2132.       Datalink.ActiveRecord := ARow - TitleOffset;
  2133.       MultiSelected := ActiveRowSelected;
  2134.     finally
  2135.       Datalink.ActiveRecord := OldActive;
  2136.     end;
  2137.     if MultiSelected then begin
  2138.       if (ARow - TitleOffset <> Datalink.ActiveRecord) then Indicator := 0
  2139.       else Indicator := 1;  { multiselected and current row }
  2140. {$IFDEF WIN32}
  2141.       FMsIndicators.BkColor := FixedColor;
  2142. {$ELSE}
  2143.       Canvas.Brush.Color := TitleColor;
  2144.       Canvas.FillRect(FixRect);
  2145. {$ENDIF}
  2146.       ALeft := FixRect.Right - FMsIndicators.Width - FrameOffs;
  2147. {$IFDEF RX_D4}
  2148.       if InBiDiMode then Inc(ALeft);
  2149. {$ENDIF}
  2150.       FMsIndicators.Draw(Self.Canvas, ALeft, (FixRect.Top +
  2151.         FixRect.Bottom - FMsIndicators.Height) shr 1, Indicator);
  2152.     end;
  2153.   end
  2154.   else if not (csLoading in ComponentState) and
  2155.     (FTitleButtons {$IFDEF RX_D4} or (FixedCols > 0) {$ENDIF}) and
  2156.     (gdFixed in AState) and (dgTitles in Options) and (ARow < TitleOffset) then
  2157.   begin
  2158.     SavePen := Canvas.Pen.Color;
  2159.     try
  2160.       Canvas.Pen.Color := clWindowFrame;
  2161.       if (dgIndicator in Options) then Dec(ACol, IndicatorOffset);
  2162.       AField := nil;
  2163.       SortMarker := smNone;
  2164. {$IFDEF WIN32}
  2165.       if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
  2166.         (ACol < Columns.Count) then
  2167.       begin
  2168.         DrawColumn := Columns[ACol];
  2169.         AField := DrawColumn.Field;
  2170.       end
  2171.       else DrawColumn := nil;
  2172. {$IFDEF RX_D4}
  2173.       if Assigned(DrawColumn) and not DrawColumn.Showing then Exit;
  2174.       TitleRect := CalcTitleRect(DrawColumn, ARow, MasterCol);
  2175.       if TitleRect.Right < ARect.Right then
  2176.         TitleRect.Right := ARect.Right;
  2177.       if MasterCol = nil then
  2178.         Exit
  2179.       else if MasterCol <> DrawColumn then
  2180.         AField := MasterCol.Field;
  2181.       DrawColumn := MasterCol;
  2182.       if ((dgColLines in Options) or FTitleButtons) and (ACol = FixedCols - 1) then
  2183.       begin
  2184.         if (ACol < Columns.Count - 1) and not (Columns[ACol + 1].Showing) then
  2185.         begin
  2186.           Canvas.MoveTo(TitleRect.Right, TitleRect.Top);
  2187.           Canvas.LineTo(TitleRect.Right, TitleRect.Bottom);
  2188.         end;
  2189.       end;
  2190.       if ((dgRowLines in Options) or FTitleButtons) and not MasterCol.Showing then
  2191.       begin
  2192.         Canvas.MoveTo(TitleRect.Left, TitleRect.Bottom);
  2193.         Canvas.LineTo(TitleRect.Right, TitleRect.Bottom);
  2194.       end;
  2195. {$ELSE}
  2196.       TitleRect := ARect;
  2197. {$ENDIF RX_D4}
  2198.       Down := FPressed and FTitleButtons and (FPressedCol = DrawColumn);
  2199.       if FTitleButtons or ([dgRowLines, dgColLines] * Options =
  2200.         [dgRowLines, dgColLines]) then
  2201.       begin
  2202.         DrawEdge(Canvas.Handle, TitleRect, EdgeFlag[Down], BF_BOTTOMRIGHT);
  2203.         DrawEdge(Canvas.Handle, TitleRect, EdgeFlag[Down], BF_TOPLEFT);
  2204.         InflateRect(TitleRect, -1, -1);
  2205.       end;
  2206.       Canvas.Font := TitleFont;
  2207.       Canvas.Brush.Color := FixedColor;
  2208.       if (DrawColumn <> nil) then begin
  2209.         Canvas.Font := DrawColumn.Title.Font;
  2210.         Canvas.Brush.Color := DrawColumn.Title.Color;
  2211.       end;
  2212.       if FTitleButtons and (AField <> nil) and Assigned(FOnGetBtnParams) then
  2213.       begin
  2214.         BackColor := Canvas.Brush.Color;
  2215.         FOnGetBtnParams(Self, AField, Canvas.Font, BackColor, SortMarker, Down);
  2216.         Canvas.Brush.Color := BackColor;
  2217.       end;
  2218.       if Down then begin
  2219.         Inc(TitleRect.Left); Inc(TitleRect.Top);
  2220.       end;
  2221.       ARect := TitleRect;
  2222.       if (DataLink = nil) or not DataLink.Active then
  2223.         Canvas.FillRect(TitleRect)
  2224.       else if (DrawColumn <> nil) then begin
  2225.         case SortMarker of
  2226.           smDown: Bmp := GetGridBitmap(gpMarkDown);
  2227.           smUp: Bmp := GetGridBitmap(gpMarkUp);
  2228.           else Bmp := nil;
  2229.         end;
  2230.         if Bmp <> nil then Indicator := Bmp.Width + 6
  2231.         else Indicator := 1;
  2232.         TextRect := TitleRect;
  2233. {$IFDEF RX_D4}
  2234.         if DrawColumn.Expandable then
  2235.           DrawExpandBtn(TitleRect, TextRect, InBiDiMode, DrawColumn.Expanded);
  2236. {$ENDIF}
  2237.         with DrawColumn.Title do
  2238.           DrawCellText(Self, ACol, ARow, MinimizeText(Caption, Canvas,
  2239.             WidthOf(TextRect) - Indicator), TextRect, Alignment, vaCenter
  2240.             {$IFDEF RX_D4}, IsRightToLeft {$ENDIF});
  2241.         if Bmp <> nil then begin
  2242.           ALeft := TitleRect.Right - Bmp.Width - 3;
  2243.           if Down then Inc(ALeft);
  2244. {$IFDEF RX_D4}
  2245.           if IsRightToLeft then ALeft := TitleRect.Left + 3;
  2246. {$ENDIF}
  2247.           if (ALeft > TitleRect.Left) and (ALeft + Bmp.Width < TitleRect.Right) then
  2248.             DrawBitmapTransparent(Canvas, ALeft, (TitleRect.Bottom +
  2249.               TitleRect.Top - Bmp.Height) div 2, Bmp, clFuchsia);
  2250.         end;
  2251.       end
  2252. {$ELSE WIN32}
  2253.       if not (dgColLines in Options) then begin
  2254.         Canvas.MoveTo(ARect.Right - 1, ARect.Top);
  2255.         Canvas.LineTo(ARect.Right - 1, ARect.Bottom);
  2256.         Dec(ARect.Right);
  2257.       end;
  2258.       if not (dgRowLines in Options) then begin
  2259.         Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
  2260.         Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
  2261.         Dec(ARect.Bottom);
  2262.       end;
  2263.       Down := FPressed and FTitleButtons and (FPressedCol = ACol);
  2264.       if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
  2265.         (ACol < FieldCount) then
  2266.       begin
  2267.         AField := Fields[ACol];
  2268.       end;
  2269.       if Down then begin
  2270.         with ARect do begin
  2271.           Canvas.Pen.Color := clBtnShadow;
  2272.           Canvas.PolyLine([Point(Left, Bottom - 1), Point(Left, Top),
  2273.             Point(Right, Top)]);
  2274.           Inc(Left, 2); Inc(Top, 2);
  2275.         end;
  2276.       end
  2277.       else Frame3D(Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
  2278.       Canvas.Font := TitleFont;
  2279.       Canvas.Brush.Color := TitleColor;
  2280.       if FTitleButtons and (AField <> nil) and Assigned(FOnGetBtnParams) then
  2281.       begin
  2282.         BackColor := Canvas.Brush.Color;
  2283.         FOnGetBtnParams(Self, AField, Canvas.Font, BackColor, SortMarker, Down);
  2284.         Canvas.Brush.Color := BackColor;
  2285.       end;
  2286.       if (DataLink = nil) or not DataLink.Active then
  2287.         Canvas.FillRect(ARect)
  2288.       else if (AField <> nil) then begin
  2289.         case SortMarker of
  2290.           smDown: Bmp := GetGridBitmap(gpMarkDown);
  2291.           smUp: Bmp := GetGridBitmap(gpMarkUp);
  2292.           else Bmp := nil;
  2293.         end;
  2294.         if Bmp <> nil then Indicator := Bmp.Width + 8
  2295.         else Indicator := 1;
  2296.         DrawCellText(Self, ACol, ARow, MinimizeText(AField.DisplayLabel,
  2297.           Canvas, WidthOf(ARect) - Indicator), ARect, taLeftJustify, vaCenter);
  2298.         if Bmp <> nil then begin
  2299.           ALeft := ARect.Right - Bmp.Width - 4;
  2300.           if Down then Inc(ALeft);
  2301.           DrawBitmapTransparent(Canvas, ALeft,
  2302.             (ARect.Bottom + ARect.Top - Bmp.Height) div 2, Bmp, clFuchsia);
  2303.         end;
  2304.       end
  2305. {$ENDIF WIN32}
  2306.       else DrawCellText(Self, ACol, ARow, '', ARect, taLeftJustify, vaCenter);
  2307.     finally
  2308.       Canvas.Pen.Color := SavePen;
  2309.     end;
  2310.   end
  2311.   else begin
  2312. {$IFDEF RX_D4}
  2313.     Canvas.Font := Self.Font;
  2314.     if (DataLink <> nil) and DataLink.Active and (ACol >= 0) and
  2315.       (ACol < Columns.Count) then
  2316.     begin
  2317.       DrawColumn := Columns[ACol];
  2318.       if DrawColumn <> nil then Canvas.Font := DrawColumn.Font;
  2319.     end;
  2320. {$ENDIF}
  2321.   end;
  2322. end;
  2323.  
  2324. {$IFDEF WIN32}
  2325. procedure TRxDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  2326.   Column: TColumn; State: TGridDrawState);
  2327. {$ELSE}
  2328. procedure TRxDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  2329.   State: TGridDrawState);
  2330. {$ENDIF}
  2331. var
  2332.   I: Integer;
  2333.   NewBackgrnd: TColor;
  2334.   Highlight: Boolean;
  2335.   Bmp: TBitmap;
  2336. {$IFDEF WIN32}
  2337.   Field: TField;
  2338. {$ENDIF}
  2339. begin
  2340. {$IFDEF WIN32}
  2341.   Field := Column.Field;
  2342. {$ENDIF}
  2343.   NewBackgrnd := Canvas.Brush.Color;
  2344.   Highlight := (gdSelected in State) and ((dgAlwaysShowSelection in Options) or
  2345.     Focused);
  2346.   GetCellProps(Field, Canvas.Font, NewBackgrnd, Highlight or ActiveRowSelected);
  2347.   Canvas.Brush.Color := NewBackgrnd;
  2348.   if FDefaultDrawing then begin
  2349.     I := GetImageIndex(Field);
  2350.     if I >= 0 then begin
  2351.       Bmp := GetGridBitmap(TGridPicture(I));
  2352.       Canvas.FillRect(Rect);
  2353.       DrawBitmapTransparent(Canvas, (Rect.Left + Rect.Right - Bmp.Width) div 2,
  2354.         (Rect.Top + Rect.Bottom - Bmp.Height) div 2, Bmp, clOlive);
  2355.     end else
  2356. {$IFDEF WIN32}
  2357.     DefaultDrawColumnCell(Rect, DataCol, Column, State);
  2358. {$ELSE}
  2359.     DefaultDrawDataCell(Rect, Field, State);
  2360. {$ENDIF}
  2361.   end;
  2362. {$IFDEF WIN32}
  2363.   if Columns.State = csDefault then
  2364.     inherited DrawDataCell(Rect, Field, State);
  2365.   inherited DrawColumnCell(Rect, DataCol, Column, State);
  2366. {$ELSE}
  2367.   inherited DrawDataCell(Rect, Field, State);
  2368. {$ENDIF}
  2369.   if FDefaultDrawing and Highlight and not (csDesigning in ComponentState)
  2370.     and not (dgRowSelect in Options)
  2371.     and (ValidParentForm(Self).ActiveControl = Self) then
  2372.     Canvas.DrawFocusRect(Rect);
  2373. end;
  2374.  
  2375. {$IFDEF WIN32}
  2376. procedure TRxDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  2377.   State: TGridDrawState);
  2378. begin
  2379. end;
  2380. {$ENDIF}
  2381.  
  2382. procedure TRxDBGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  2383. var
  2384.   Coord: TGridCoord;
  2385. begin
  2386.   Coord := MouseCoord(X, Y);
  2387.   ACol := Coord.X;
  2388.   ARow := Coord.Y;
  2389. end;
  2390.  
  2391. {$IFDEF WIN32}
  2392.  
  2393. procedure TRxDBGrid.SaveColumnsLayout(IniFile: TObject;
  2394.   const Section: string);
  2395. var
  2396.   I: Integer;
  2397.   S: string;
  2398. begin
  2399.   if Section <> '' then S := Section
  2400.   else S := GetDefaultSection(Self);
  2401.   IniEraseSection(IniFile, S);
  2402.   with Columns do begin
  2403.     for I := 0 to Count - 1 do begin
  2404.       IniWriteString(IniFile, S, Format('%s.%s', [Name, Items[I].FieldName]),
  2405.         Format('%d,%d', [Items[I].Index, Items[I].Width]));
  2406.     end;
  2407.   end;
  2408. end;
  2409.  
  2410. procedure TRxDBGrid.RestoreColumnsLayout(IniFile: TObject;
  2411.   const Section: string);
  2412. type
  2413.   TColumnInfo = record
  2414.     Column: TColumn;
  2415.     EndIndex: Integer;
  2416.   end;
  2417.   PColumnArray = ^TColumnArray;
  2418.   TColumnArray = array[0..0] of TColumnInfo;
  2419. const
  2420.   Delims = [' ',','];
  2421. var
  2422.   I, J: Integer;
  2423.   SectionName, S: string;
  2424.   ColumnArray: PColumnArray;
  2425. begin
  2426.   if Section <> '' then SectionName := Section
  2427.   else SectionName := GetDefaultSection(Self);
  2428.   with Columns do begin
  2429.     ColumnArray := AllocMemo(Count * SizeOf(TColumnInfo));
  2430.     try
  2431.       for I := 0 to Count - 1 do begin
  2432.         S := IniReadString(IniFile, SectionName,
  2433.           Format('%s.%s', [Name, Items[I].FieldName]), '');
  2434.         ColumnArray^[I].Column := Items[I];
  2435.         ColumnArray^[I].EndIndex := Items[I].Index;
  2436.         if S <> '' then begin
  2437.           ColumnArray^[I].EndIndex := StrToIntDef(ExtractWord(1, S, Delims),
  2438.             ColumnArray^[I].EndIndex);
  2439.           Items[I].Width := StrToIntDef(ExtractWord(2, S, Delims),
  2440.             Items[I].Width);
  2441.         end;
  2442.       end;
  2443.       for I := 0 to Count - 1 do begin
  2444.         for J := 0 to Count - 1 do begin
  2445.           if ColumnArray^[J].EndIndex = I then begin
  2446.             ColumnArray^[J].Column.Index := ColumnArray^[J].EndIndex;
  2447.             Break;
  2448.           end;
  2449.         end;
  2450.       end;
  2451.     finally
  2452.       FreeMemo(Pointer(ColumnArray));
  2453.     end;
  2454.   end;
  2455. end;
  2456.  
  2457. procedure TRxDBGrid.SaveLayoutReg(IniFile: TRegIniFile);
  2458. begin
  2459.   InternalSaveLayout(IniFile, '');
  2460. end;
  2461.  
  2462. procedure TRxDBGrid.RestoreLayoutReg(IniFile: TRegIniFile);
  2463. begin
  2464.   InternalRestoreLayout(IniFile, '');
  2465. end;
  2466.  
  2467. {$ENDIF WIN32}
  2468.  
  2469. procedure TRxDBGrid.InternalSaveLayout(IniFile: TObject;
  2470.   const Section: string);
  2471. begin
  2472.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  2473. {$IFDEF WIN32}
  2474.     if StoreColumns then SaveColumnsLayout(IniFile, Section) else
  2475. {$ENDIF}
  2476.     InternalSaveFields(DataSource.DataSet, IniFile, Section);
  2477. end;
  2478.  
  2479. procedure TRxDBGrid.InternalRestoreLayout(IniFile: TObject;
  2480.   const Section: string);
  2481. begin
  2482.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then begin
  2483.     HandleNeeded;
  2484. {$IFDEF WIN32}
  2485.     BeginLayout;
  2486.     try
  2487.       if StoreColumns then RestoreColumnsLayout(IniFile, Section) else
  2488. {$ENDIF}
  2489.       InternalRestoreFields(DataSource.DataSet, IniFile, Section, False);
  2490. {$IFDEF WIN32}
  2491.     finally
  2492.       EndLayout;
  2493.     end;
  2494. {$ENDIF}
  2495.   end;
  2496. end;
  2497.  
  2498. procedure TRxDBGrid.SaveLayout(IniFile: TIniFile);
  2499. begin
  2500.   InternalSaveLayout(IniFile, '');
  2501. end;
  2502.  
  2503. procedure TRxDBGrid.RestoreLayout(IniFile: TIniFile);
  2504. begin
  2505.   InternalRestoreLayout(IniFile, '');
  2506. end;
  2507.  
  2508. procedure TRxDBGrid.IniSave(Sender: TObject);
  2509. var
  2510.   Section: string;
  2511. begin
  2512.   if (Name <> '') and (FIniLink.IniObject <> nil) then begin
  2513. {$IFDEF WIN32}
  2514.     if StoreColumns then
  2515.       Section := FIniLink.RootSection + GetDefaultSection(Self) else
  2516. {$ENDIF}
  2517.     if (FIniLink.RootSection <> '') and (DataSource <> nil) and
  2518.       (DataSource.DataSet <> nil) then
  2519.       Section := FIniLink.RootSection + DataSetSectionName(DataSource.DataSet)
  2520.     else Section := '';
  2521.     InternalSaveLayout(FIniLink.IniObject, Section);
  2522.   end;
  2523. end;
  2524.  
  2525. procedure TRxDBGrid.IniLoad(Sender: TObject);
  2526. var
  2527.   Section: string;
  2528. begin
  2529.   if (Name <> '') and (FIniLink.IniObject <> nil) then begin
  2530. {$IFDEF WIN32}
  2531.     if StoreColumns then
  2532.       Section := FIniLink.RootSection + GetDefaultSection(Self) else
  2533. {$ENDIF}
  2534.     if (FIniLink.RootSection <> '') and (DataSource <> nil) and
  2535.       (DataSource.DataSet <> nil) then
  2536.       Section := FIniLink.RootSection + DataSetSectionName(DataSource.DataSet)
  2537.     else Section := '';
  2538.     InternalRestoreLayout(FIniLink.IniObject, Section);
  2539.   end;
  2540. end;
  2541.  
  2542. { TRxDBComboEdit }
  2543.  
  2544. procedure ResetMaxLength(DBEdit: TRxDBComboEdit);
  2545. var
  2546.   F: TField;
  2547. begin
  2548.   with DBEdit do
  2549.     if (MaxLength > 0) and (DataSource <> nil) and
  2550.       (DataSource.DataSet <> nil) then
  2551.     begin
  2552.       F := DataSource.DataSet.FindField(DataField);
  2553.       if Assigned(F) and (F.DataType = ftString) and
  2554.         (F.Size = MaxLength) then MaxLength := 0;
  2555.     end;
  2556. end;
  2557.  
  2558. constructor TRxDBComboEdit.Create(AOwner: TComponent);
  2559. begin
  2560.   inherited Create(AOwner);
  2561. {$IFDEF WIN32}
  2562.   ControlStyle := ControlStyle + [csReplicatable];
  2563. {$ENDIF}
  2564.   inherited ReadOnly := True;
  2565.   FDataLink := TFieldDataLink.Create;
  2566.   FDataLink.Control := Self;
  2567.   FDataLink.OnDataChange := DataChange;
  2568.   FDataLink.OnEditingChange := EditingChange;
  2569.   FDataLink.OnUpdateData := UpdateData;
  2570.   AlwaysEnable := True;
  2571. end;
  2572.  
  2573. destructor TRxDBComboEdit.Destroy;
  2574. begin
  2575.   FDataLink.Free;
  2576.   FDataLink := nil;
  2577. {$IFDEF WIN32}
  2578.   FCanvas.Free;
  2579. {$ENDIF}
  2580.   inherited Destroy;
  2581. end;
  2582.  
  2583. procedure TRxDBComboEdit.Loaded;
  2584. begin
  2585.   inherited Loaded;
  2586.   ResetMaxLength(Self);
  2587.   if (csDesigning in ComponentState) then DataChange(Self);
  2588. end;
  2589.  
  2590. procedure TRxDBComboEdit.Notification(AComponent: TComponent;
  2591.   Operation: TOperation);
  2592. begin
  2593.   inherited Notification(AComponent, Operation);
  2594.   if (Operation = opRemove) and (FDataLink <> nil) and
  2595.     (AComponent = DataSource) then DataSource := nil;
  2596. end;
  2597.  
  2598. procedure TRxDBComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
  2599. begin
  2600.   inherited KeyDown(Key, Shift);
  2601.   if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
  2602.     FDataLink.Edit;
  2603. end;
  2604.  
  2605. procedure TRxDBComboEdit.KeyPress(var Key: Char);
  2606. begin
  2607.   inherited KeyPress(Key);
  2608.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  2609.     not FDataLink.Field.IsValidChar(Key) then
  2610.   begin
  2611.     Beep;
  2612.     Key := #0;
  2613.   end;
  2614.   case Key of
  2615.     ^H, ^V, ^X, #32..#255:
  2616.       FDataLink.Edit;
  2617.     #27:
  2618.       begin
  2619.         FDataLink.Reset;
  2620.         SelectAll;
  2621.         Key := #0;
  2622.       end;
  2623.   end;
  2624. end;
  2625.  
  2626. function TRxDBComboEdit.EditCanModify: Boolean;
  2627. begin
  2628.   Result := FDataLink.Edit;
  2629. end;
  2630.  
  2631. procedure TRxDBComboEdit.Reset;
  2632. begin
  2633.   FDataLink.Reset;
  2634.   SelectAll;
  2635. end;
  2636.  
  2637. procedure TRxDBComboEdit.SetFocused(Value: Boolean);
  2638. begin
  2639.   if FFocused <> Value then begin
  2640.     FFocused := Value;
  2641.     if (Alignment <> taLeftJustify) and not IsMasked then Invalidate;
  2642.     FDataLink.Reset;
  2643.   end;
  2644. end;
  2645.  
  2646. procedure TRxDBComboEdit.Change;
  2647. begin
  2648.   FDataLink.Modified;
  2649.   inherited Change;
  2650. end;
  2651.  
  2652. function TRxDBComboEdit.GetDataSource: TDataSource;
  2653. begin
  2654.   Result := FDataLink.DataSource;
  2655. end;
  2656.  
  2657. procedure TRxDBComboEdit.SetDataSource(Value: TDataSource);
  2658. begin
  2659. {$IFDEF RX_D4}
  2660.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  2661. {$ENDIF}
  2662.     FDataLink.DataSource := Value;
  2663. {$IFDEF WIN32}
  2664.   if Value <> nil then Value.FreeNotification(Self);
  2665. {$ENDIF}
  2666. end;
  2667.  
  2668. function TRxDBComboEdit.GetDataField: string;
  2669. begin
  2670.   Result := FDataLink.FieldName;
  2671. end;
  2672.  
  2673. procedure TRxDBComboEdit.SetDataField(const Value: string);
  2674. begin
  2675.   if not (csDesigning in ComponentState) then ResetMaxLength(Self);
  2676.   FDataLink.FieldName := Value;
  2677. end;
  2678.  
  2679. function TRxDBComboEdit.GetReadOnly: Boolean;
  2680. begin
  2681.   Result := FDataLink.ReadOnly;
  2682. end;
  2683.  
  2684. procedure TRxDBComboEdit.SetReadOnly(Value: Boolean);
  2685. begin
  2686.   FDataLink.ReadOnly := Value;
  2687. end;
  2688.  
  2689. function TRxDBComboEdit.GetField: TField;
  2690. begin
  2691.   Result := FDataLink.Field;
  2692. end;
  2693.  
  2694. procedure TRxDBComboEdit.DataChange(Sender: TObject);
  2695. begin
  2696.   if FDataLink.Field <> nil then begin
  2697.     if Alignment <> FDataLink.Field.Alignment then begin
  2698.       EditText := '';  {forces update}
  2699.       Alignment := FDataLink.Field.Alignment;
  2700.     end;
  2701.     EditMask := FDataLink.Field.EditMask;
  2702.     if not (csDesigning in ComponentState) then begin
  2703.       if (FDataLink.Field.DataType = ftString) and (MaxLength = 0) then
  2704.         MaxLength := FDataLink.Field.Size;
  2705.     end;
  2706.     if FFocused and FDataLink.CanModify then
  2707.       Text := FDataLink.Field.Text
  2708.     else begin
  2709.       EditText := FDataLink.Field.DisplayText;
  2710.       {if FDataLink.Editing then Modified := True;}
  2711.     end;
  2712.   end
  2713.   else begin
  2714.     Alignment := taLeftJustify;
  2715.     EditMask := '';
  2716.     if csDesigning in ComponentState then EditText := Name
  2717.     else EditText := '';
  2718.   end;
  2719. end;
  2720.  
  2721. procedure TRxDBComboEdit.EditingChange(Sender: TObject);
  2722. begin
  2723.   inherited ReadOnly := not FDataLink.Editing;
  2724. end;
  2725.  
  2726. procedure TRxDBComboEdit.UpdateData(Sender: TObject);
  2727. begin
  2728.   ValidateEdit;
  2729.   FDataLink.Field.Text := Text;
  2730. end;
  2731.  
  2732. procedure TRxDBComboEdit.WMPaste(var Message: TMessage);
  2733. begin
  2734.   FDataLink.Edit;
  2735.   inherited;
  2736. end;
  2737.  
  2738. procedure TRxDBComboEdit.WMCut(var Message: TMessage);
  2739. begin
  2740.   FDataLink.Edit;
  2741.   inherited;
  2742. end;
  2743.  
  2744. procedure TRxDBComboEdit.CMEnter(var Message: TCMEnter);
  2745. begin
  2746.   SetFocused(True);
  2747.   inherited;
  2748. {$IFDEF RX_D3}
  2749.   if SysLocale.FarEast and FDataLink.CanModify then
  2750.     inherited ReadOnly := False;
  2751. {$ENDIF}
  2752. end;
  2753.  
  2754. procedure TRxDBComboEdit.CMExit(var Message: TCMExit);
  2755. begin
  2756.   try
  2757.     FDataLink.UpdateRecord;
  2758.   except
  2759.     SelectAll;
  2760.     if CanFocus then SetFocus;
  2761.     raise;
  2762.   end;
  2763.   SetFocused(False);
  2764.   CheckCursor;
  2765.   DoExit;
  2766. end;
  2767.  
  2768. {$IFDEF WIN32}
  2769. procedure TRxDBComboEdit.WMPaint(var Message: TWMPaint);
  2770. var
  2771.   S: string;
  2772. begin
  2773.   if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then
  2774.   begin
  2775.     S := FDataLink.Field.DisplayText;
  2776.     case CharCase of
  2777.       ecUpperCase: S := AnsiUpperCase(S);
  2778.       ecLowerCase: S := AnsiLowerCase(S);
  2779.     end;
  2780.   end
  2781.   else S := EditText;
  2782.   if not PaintComboEdit(Self, S, Alignment, True, FCanvas, Message) then
  2783.     inherited;
  2784. end;
  2785.  
  2786. procedure TRxDBComboEdit.CMGetDataLink(var Message: TMessage);
  2787. begin
  2788.   Message.Result := Integer(FDataLink);
  2789. end;
  2790. {$ENDIF}
  2791.  
  2792. {$IFDEF RX_D4}
  2793. function TRxDBComboEdit.UseRightToLeftAlignment: Boolean;
  2794. begin
  2795.   Result := DBUseRightToLeftAlignment(Self, Field);
  2796. end;
  2797.  
  2798. function TRxDBComboEdit.ExecuteAction(Action: TBasicAction): Boolean;
  2799. begin
  2800.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  2801.     FDataLink.ExecuteAction(Action);
  2802. end;
  2803.  
  2804. function TRxDBComboEdit.UpdateAction(Action: TBasicAction): Boolean;
  2805. begin
  2806.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  2807.     FDataLink.UpdateAction(Action);
  2808. end;
  2809. {$ENDIF}
  2810.  
  2811. { TDBDateEdit }
  2812.  
  2813. constructor TDBDateEdit.Create(AOwner: TComponent);
  2814. begin
  2815.   inherited Create(AOwner);
  2816. {$IFDEF WIN32}
  2817.   ControlStyle := ControlStyle + [csReplicatable];
  2818. {$ENDIF}
  2819.   inherited ReadOnly := True;
  2820.   FDataLink := TFieldDataLink.Create;
  2821.   FDataLink.Control := Self;
  2822.   FDataLink.OnDataChange := DataChange;
  2823.   FDataLink.OnEditingChange := EditingChange;
  2824.   FDataLink.OnUpdateData := UpdateData;
  2825.   Self.OnAcceptDate := AfterPopup;
  2826.   AlwaysEnable := True;
  2827.   UpdateMask;
  2828. end;
  2829.  
  2830. destructor TDBDateEdit.Destroy;
  2831. begin
  2832.   FDataLink.Free;
  2833.   FDataLink := nil;
  2834. {$IFDEF WIN32}
  2835.   FCanvas.Free;
  2836. {$ENDIF}
  2837.   inherited Destroy;
  2838. end;
  2839.  
  2840. procedure TDBDateEdit.AfterPopup(Sender: TObject; var Date: TDateTime;
  2841.   var Action: Boolean);
  2842. begin
  2843.   Action := Action and (DataSource <> nil) and (DataSource.DataSet <> nil) and
  2844.     DataSource.DataSet.CanModify;
  2845.   if Action then Action := EditCanModify;
  2846. end;
  2847.  
  2848. procedure TDBDateEdit.Notification(AComponent: TComponent;
  2849.   Operation: TOperation);
  2850. begin
  2851.   inherited Notification(AComponent, Operation);
  2852.   if (Operation = opRemove) and (FDataLink <> nil) and
  2853.     (AComponent = DataSource) then DataSource := nil;
  2854. end;
  2855.  
  2856. procedure TDBDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
  2857. begin
  2858.   inherited KeyDown(Key, Shift);
  2859.   if not ReadOnly and ((Key = VK_DELETE) or ((Key = VK_INSERT)
  2860.     and (ssShift in Shift))) then
  2861.     FDataLink.Edit;
  2862. end;
  2863.  
  2864. procedure TDBDateEdit.KeyPress(var Key: Char);
  2865. begin
  2866.   inherited KeyPress(Key);
  2867.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  2868.     not (Key in ['0'..'9']) and (Key <> DateSeparator) then
  2869.   begin
  2870.     Beep;
  2871.     Key := #0;
  2872.   end;
  2873.   case Key of
  2874.     ^H, ^V, ^X, '0'..'9': FDataLink.Edit;
  2875.     #27:
  2876.       begin
  2877.         Reset;
  2878.         Key := #0;
  2879.       end;
  2880.   end;
  2881. end;
  2882.  
  2883. function TDBDateEdit.EditCanModify: Boolean;
  2884. begin
  2885.   Result := FDataLink.Edit;
  2886. end;
  2887.  
  2888. procedure TDBDateEdit.Reset;
  2889. begin
  2890.   FDataLink.Reset;
  2891.   SelectAll;
  2892. end;
  2893.  
  2894. procedure TDBDateEdit.Change;
  2895. begin
  2896.   if not Formatting then FDataLink.Modified;
  2897.   inherited Change;
  2898. end;
  2899.  
  2900. function TDBDateEdit.GetDataSource: TDataSource;
  2901. begin
  2902.   Result := FDataLink.DataSource;
  2903. end;
  2904.  
  2905. procedure TDBDateEdit.SetDataSource(Value: TDataSource);
  2906. begin
  2907. {$IFDEF RX_D4}
  2908.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  2909. {$ENDIF}
  2910.     FDataLink.DataSource := Value;
  2911. {$IFDEF WIN32}
  2912.   if Value <> nil then Value.FreeNotification(Self);
  2913. {$ENDIF}
  2914. end;
  2915.  
  2916. function TDBDateEdit.GetDataField: string;
  2917. begin
  2918.   Result := FDataLink.FieldName;
  2919. end;
  2920.  
  2921. procedure TDBDateEdit.SetDataField(const Value: string);
  2922. begin
  2923.   FDataLink.FieldName := Value;
  2924. end;
  2925.  
  2926. function TDBDateEdit.GetReadOnly: Boolean;
  2927. begin
  2928.   Result := FDataLink.ReadOnly;
  2929. end;
  2930.  
  2931. procedure TDBDateEdit.SetReadOnly(Value: Boolean);
  2932. begin
  2933.   FDataLink.ReadOnly := Value;
  2934. end;
  2935.  
  2936. function TDBDateEdit.GetField: TField;
  2937. begin
  2938.   Result := FDataLink.Field;
  2939. end;
  2940.  
  2941. procedure TDBDateEdit.UpdateMask;
  2942. begin
  2943.   UpdateFormat;
  2944.   UpdatePopup;
  2945.   DataChange(nil);
  2946. end;
  2947.  
  2948. procedure TDBDateEdit.DataChange(Sender: TObject);
  2949. begin
  2950.   if FDataLink.Field <> nil then begin
  2951.     EditMask := GetDateMask;
  2952.     Self.Date := FDataLink.Field.AsDateTime;
  2953.   end
  2954.   else begin
  2955.     if csDesigning in ComponentState then begin
  2956.       EditMask := '';
  2957.       EditText := Name;
  2958.     end
  2959.     else begin
  2960.       EditMask := GetDateMask;
  2961.       if DefaultToday then Date := SysUtils.Date
  2962.       else Date := NullDate;
  2963.     end;
  2964.   end;
  2965. end;
  2966.  
  2967. procedure TDBDateEdit.EditingChange(Sender: TObject);
  2968. begin
  2969.   inherited ReadOnly := not FDataLink.Editing;
  2970.   if FDataLink.Editing and DefaultToday and (FDataLink.Field <> nil) and
  2971.     (FDataLink.Field.AsDateTime = NullDate) then
  2972.     FDataLink.Field.AsDateTime := SysUtils.Now;
  2973. end;
  2974.  
  2975. procedure TDBDateEdit.UpdateData(Sender: TObject);
  2976. var
  2977.   D: TDateTime;
  2978. begin
  2979.   ValidateEdit;
  2980.   D := Self.Date;
  2981.   if D <> NullDate then
  2982.     FDataLink.Field.AsDateTime := D + Frac(FDataLink.Field.AsDateTime)
  2983.   else FDataLink.Field.Clear;
  2984. end;
  2985.  
  2986. {$IFDEF WIN32}
  2987. procedure TDBDateEdit.CMGetDataLink(var Message: TMessage);
  2988. begin
  2989.   Message.Result := Integer(FDataLink);
  2990. end;
  2991.  
  2992. procedure TDBDateEdit.WMPaint(var Message: TWMPaint);
  2993. var
  2994.   S: string;
  2995. begin
  2996.   if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then begin
  2997.     if FDataLink.Field.IsNull then begin
  2998.       S := GetDateFormat;
  2999.       S := ReplaceStr(ReplaceStr(ReplaceStr(ReplaceStr(S, '/', DateSeparator),
  3000.         'Y', ' '), 'M', ' '), 'D', ' ');
  3001.     end
  3002.     else
  3003.       S := FormatDateTime(GetDateFormat, FDataLink.Field.AsDateTime);
  3004.   end else S := EditText;
  3005.   if not PaintComboEdit(Self, S, Alignment, True, FCanvas, Message) then
  3006.     inherited;
  3007. end;
  3008.  
  3009. procedure TDBDateEdit.AcceptValue(const Value: Variant);
  3010. begin
  3011.   if VarIsNull(Value) or VarIsEmpty(Value) then FDataLink.Field.Clear
  3012.   else FDataLink.Field.AsDateTime :=
  3013.     VarToDateTime(Value) + Frac(FDataLink.Field.AsDateTime);
  3014.   DoChange;
  3015. end;
  3016. {$ENDIF}
  3017.  
  3018. procedure TDBDateEdit.ApplyDate(Value: TDateTime);
  3019. begin
  3020.   FDataLink.Edit;
  3021.   inherited ApplyDate(Value);
  3022. end;
  3023.  
  3024. procedure TDBDateEdit.WMPaste(var Message: TMessage);
  3025. begin
  3026.   FDataLink.Edit;
  3027.   inherited;
  3028. end;
  3029.  
  3030. procedure TDBDateEdit.WMCut(var Message: TMessage);
  3031. begin
  3032.   FDataLink.Edit;
  3033.   inherited;
  3034. end;
  3035.  
  3036. procedure TDBDateEdit.CMEnter(var Message: TCMEnter);
  3037. begin
  3038.   inherited;
  3039. end;
  3040.  
  3041. procedure TDBDateEdit.CMExit(var Message: TCMExit);
  3042. begin
  3043.   try
  3044.     if not (csDesigning in ComponentState) and CheckOnExit then
  3045.       CheckValidDate;
  3046.     FDataLink.UpdateRecord;
  3047.   except
  3048.     SelectAll;
  3049.     if CanFocus then SetFocus;
  3050.     raise;
  3051.   end;
  3052.   CheckCursor;
  3053.   DoExit;
  3054. end;
  3055.  
  3056. {$IFDEF RX_D4}
  3057. function TDBDateEdit.UseRightToLeftAlignment: Boolean;
  3058. begin
  3059.   Result := DBUseRightToLeftAlignment(Self, Field);
  3060. end;
  3061.  
  3062. function TDBDateEdit.ExecuteAction(Action: TBasicAction): Boolean;
  3063. begin
  3064.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  3065.     FDataLink.ExecuteAction(Action);
  3066. end;
  3067.  
  3068. function TDBDateEdit.UpdateAction(Action: TBasicAction): Boolean;
  3069. begin
  3070.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  3071.     FDataLink.UpdateAction(Action);
  3072. end;
  3073. {$ENDIF}
  3074.  
  3075. { TRxDBCalcEdit }
  3076.  
  3077. constructor TRxDBCalcEdit.Create(AOwner: TComponent);
  3078. begin
  3079.   inherited Create(AOwner);
  3080. {$IFDEF WIN32}
  3081.   ControlStyle := ControlStyle + [csReplicatable];
  3082. {$ENDIF}
  3083.   inherited ReadOnly := True;
  3084.   FDataLink := TFieldDataLink.Create;
  3085.   FDataLink.Control := Self;
  3086.   FDataLink.OnDataChange := DataChange;
  3087.   FDataLink.OnEditingChange := EditingChange;
  3088.   FDataLink.OnUpdateData := UpdateFieldData;
  3089.   AlwaysEnable := True;
  3090. end;
  3091.  
  3092. destructor TRxDBCalcEdit.Destroy;
  3093. begin
  3094.   FDataLink.Free;
  3095.   FDataLink := nil;
  3096.   inherited Destroy;
  3097. end;
  3098.  
  3099. procedure TRxDBCalcEdit.Notification(AComponent: TComponent;
  3100.   Operation: TOperation);
  3101. begin
  3102.   inherited Notification(AComponent, Operation);
  3103.   if (Operation = opRemove) and (FDataLink <> nil) and
  3104.     (AComponent = DataSource) then DataSource := nil;
  3105. end;
  3106.  
  3107. procedure TRxDBCalcEdit.KeyDown(var Key: Word; Shift: TShiftState);
  3108. begin
  3109.   inherited KeyDown(Key, Shift);
  3110.   if not ReadOnly and ((Key = VK_DELETE) or ((Key = VK_INSERT)
  3111.     and (ssShift in Shift))) then FDataLink.Edit;
  3112. end;
  3113.  
  3114. procedure TRxDBCalcEdit.KeyPress(var Key: Char);
  3115. begin
  3116.   inherited KeyPress(Key);
  3117.   case Key of
  3118.     ^H, ^V, ^X, #32..#255:
  3119.       if not PopupVisible then FDataLink.Edit;
  3120.     #27:
  3121.       begin
  3122.         FDataLink.Reset;
  3123.         SelectAll;
  3124.         Key := #0;
  3125.       end;
  3126.   end;
  3127. end;
  3128.  
  3129. function TRxDBCalcEdit.IsValidChar(Key: Char): Boolean;
  3130. begin
  3131.   Result := inherited IsValidChar(Key);
  3132.   if Result and (FDatalink.Field <> nil) then
  3133.     Result := FDatalink.Field.IsValidChar(Key);
  3134. end;
  3135.  
  3136. procedure TRxDBCalcEdit.UpdatePopup;
  3137. var
  3138.   Precision: Byte;
  3139. begin
  3140.   Precision := DefCalcPrecision;
  3141.   if (FDatalink <> nil) and (FDatalink.Field <> nil) and
  3142.     (FDatalink.Field is TFloatField) then
  3143.     Precision := TFloatField(FDatalink.Field).Precision;
  3144.   if FPopup <> nil then
  3145.     SetupPopupCalculator(FPopup, Precision, BeepOnError);
  3146. end;
  3147.  
  3148. function TRxDBCalcEdit.EditCanModify: Boolean;
  3149. begin
  3150.   Result := FDataLink.Edit;
  3151. end;
  3152.  
  3153. {$IFDEF WIN32}
  3154. function TRxDBCalcEdit.GetDisplayText: string;
  3155. var
  3156.   E: Extended;
  3157. begin
  3158.   if (csPaintCopy in ControlState) and (FDatalink.Field <> nil) then begin
  3159.     if FDataLink.Field.IsNull then E := 0.0
  3160.     else if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
  3161.       E := FDataLink.Field.AsInteger
  3162.     else if FDataLink.Field.DataType = ftBoolean then
  3163.       E := Ord(FDataLink.Field.AsBoolean)
  3164. {$IFDEF RX_D4}
  3165.     else if FDataLink.Field is TLargeintField then
  3166.       E := TLargeintField(FDataLink.Field).AsLargeInt
  3167. {$ENDIF}
  3168.     else E := FDataLink.Field.AsFloat;
  3169.     if FDataLink.Field.IsNull then Result := ''
  3170.     else Result := FormatDisplayText(E);
  3171.   end
  3172.   else begin
  3173.     if (FDataLink.Field = nil) then begin
  3174.       if (csDesigning in ComponentState) then Result := Format('(%s)', [Name])
  3175.       else Result := '';
  3176.     end
  3177.     else Result := inherited GetDisplayText;
  3178.   end;
  3179. end;
  3180. {$ENDIF}
  3181.  
  3182. procedure TRxDBCalcEdit.Reset;
  3183. begin
  3184.   FDataLink.Reset;
  3185.   inherited Reset;
  3186. end;
  3187.  
  3188. procedure TRxDBCalcEdit.Change;
  3189. begin
  3190.   if not Formatting then FDataLink.Modified;
  3191.   inherited Change;
  3192. end;
  3193.  
  3194. function TRxDBCalcEdit.GetDataSource: TDataSource;
  3195. begin
  3196.   Result := FDataLink.DataSource;
  3197. end;
  3198.  
  3199. procedure TRxDBCalcEdit.SetDataSource(Value: TDataSource);
  3200. begin
  3201.   if FDataLink.DataSource <> Value then begin
  3202. {$IFDEF RX_D4}
  3203.     if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  3204. {$ENDIF}
  3205.       FDataLink.DataSource := Value;
  3206. {$IFDEF WIN32}
  3207.     if Value <> nil then Value.FreeNotification(Self);
  3208. {$ENDIF}
  3209.     UpdateFieldParams;
  3210.   end;
  3211. end;
  3212.  
  3213. function TRxDBCalcEdit.GetDataField: string;
  3214. begin
  3215.   Result := FDataLink.FieldName;
  3216. end;
  3217.  
  3218. procedure TRxDBCalcEdit.SetDataField(const Value: string);
  3219. begin
  3220.   if FDataLink.FieldName <> Value then begin
  3221.     FDataLink.FieldName := Value;
  3222.     UpdateFieldParams;
  3223.   end;
  3224. end;
  3225.  
  3226. procedure TRxDBCalcEdit.SetDefaultParams(Value: Boolean);
  3227. begin
  3228.   if DefaultParams <> Value then begin
  3229.     FDefaultParams := Value;
  3230.     if FDefaultParams then UpdateFieldParams;
  3231.   end;
  3232. end;
  3233.  
  3234. procedure TRxDBCalcEdit.UpdateFieldParams;
  3235. begin
  3236.   if FDatalink.Field <> nil then begin
  3237.     if FDatalink.Field is TNumericField then begin
  3238.       if TNumericField(FDatalink.Field).DisplayFormat <> '' then
  3239.         DisplayFormat := TNumericField(FDatalink.Field).DisplayFormat;
  3240.       Alignment := TNumericField(FDatalink.Field).Alignment;
  3241.     end;
  3242. {$IFDEF RX_D4}
  3243.     if FDatalink.Field is TLargeintField then begin
  3244.       MaxValue := TLargeintField(FDatalink.Field).MaxValue;
  3245.       MinValue := TLargeintField(FDatalink.Field).MinValue;
  3246.       DecimalPlaces := 0;
  3247.       if DisplayFormat = '' then DisplayFormat := ',#';
  3248.     end else
  3249. {$ENDIF}
  3250.     if FDatalink.Field is TIntegerField then begin
  3251.       MaxValue := TIntegerField(FDatalink.Field).MaxValue;
  3252.       MinValue := TIntegerField(FDatalink.Field).MinValue;
  3253.       DecimalPlaces := 0;
  3254.       if DisplayFormat = '' then DisplayFormat := ',#';
  3255.     end
  3256. {$IFDEF WIN32}
  3257.     else if FDatalink.Field is TBCDField then begin
  3258.       MaxValue := TBCDField(FDatalink.Field).MaxValue;
  3259.       MinValue := TBCDField(FDatalink.Field).MinValue;
  3260.     end
  3261. {$ENDIF}
  3262.     else if FDatalink.Field is TFloatField then begin
  3263.       MaxValue := TFloatField(FDatalink.Field).MaxValue;
  3264.       MinValue := TFloatField(FDatalink.Field).MinValue;
  3265.       DecimalPlaces := TFloatField(FDatalink.Field).Precision;
  3266.     end
  3267.     else if FDatalink.Field is TBooleanField then begin
  3268.       MinValue := 0;
  3269.       MaxValue := 1;
  3270.       DecimalPlaces := 0;
  3271.       if DisplayFormat = '' then DisplayFormat := ',#';
  3272.     end;
  3273.   end;
  3274.   UpdatePopup;
  3275. end;
  3276.  
  3277. function TRxDBCalcEdit.GetReadOnly: Boolean;
  3278. begin
  3279.   Result := FDataLink.ReadOnly;
  3280. end;
  3281.  
  3282. procedure TRxDBCalcEdit.SetReadOnly(Value: Boolean);
  3283. begin
  3284.   FDataLink.ReadOnly := Value;
  3285. end;
  3286.  
  3287. function TRxDBCalcEdit.GetField: TField;
  3288. begin
  3289.   Result := FDataLink.Field;
  3290. end;
  3291.  
  3292. procedure TRxDBCalcEdit.DataChange(Sender: TObject);
  3293. begin
  3294.   if FDefaultParams then UpdateFieldParams;
  3295.   if FDataLink.Field <> nil then begin
  3296.     if FDataLink.Field.IsNull then begin
  3297.       Self.Value := 0.0;
  3298.       EditText := '';
  3299.     end
  3300.     else if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
  3301.       Self.AsInteger := FDataLink.Field.AsInteger
  3302.     else if FDataLink.Field.DataType = ftBoolean then
  3303.       Self.AsInteger := Ord(FDataLink.Field.AsBoolean)
  3304. {$IFDEF RX_D4}
  3305.     else if FDataLink.Field is TLargeintField then
  3306.       Self.Value := TLargeintField(FDataLink.Field).AsLargeInt
  3307. {$ENDIF}
  3308.     else Self.Value := FDataLink.Field.AsFloat;
  3309.     DataChanged;
  3310.   end
  3311.   else begin
  3312.     if csDesigning in ComponentState then begin
  3313.       Self.Value := 0;
  3314.       EditText := Format('(%s)', [Name]);
  3315.     end
  3316.     else Self.Value := 0;
  3317.   end;
  3318. end;
  3319.  
  3320. procedure TRxDBCalcEdit.EditingChange(Sender: TObject);
  3321. begin
  3322.   inherited ReadOnly := not FDataLink.Editing;
  3323. end;
  3324.  
  3325. procedure TRxDBCalcEdit.UpdateFieldData(Sender: TObject);
  3326. begin
  3327.   inherited UpdateData;
  3328.   if (Value = 0) and ZeroEmpty then FDataLink.Field.Clear
  3329.   else if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
  3330.     FDataLink.Field.AsInteger := Self.AsInteger
  3331.   else if FDataLink.Field.DataType = ftBoolean then
  3332.     FDataLink.Field.AsBoolean := Boolean(Self.AsInteger)
  3333.   else FDataLink.Field.AsFloat := Self.Value;
  3334. end;
  3335.  
  3336. {$IFDEF WIN32}
  3337. procedure TRxDBCalcEdit.CMGetDataLink(var Message: TMessage);
  3338. begin
  3339.   Message.Result := Integer(FDataLink);
  3340. end;
  3341.  
  3342. procedure TRxDBCalcEdit.AcceptValue(const Value: Variant);
  3343. begin
  3344.   if VarIsNull(Value) or VarIsEmpty(Value) then FDataLink.Field.Clear
  3345.   else FDataLink.Field.Value := Value;
  3346.   DoChange;
  3347. end;
  3348. {$ENDIF}
  3349.  
  3350. procedure TRxDBCalcEdit.WMPaste(var Message: TMessage);
  3351. begin
  3352.   FDataLink.Edit;
  3353.   inherited;
  3354. end;
  3355.  
  3356. procedure TRxDBCalcEdit.WMCut(var Message: TMessage);
  3357. begin
  3358.   FDataLink.Edit;
  3359.   inherited;
  3360. end;
  3361.  
  3362. procedure TRxDBCalcEdit.CMEnter(var Message: TCMEnter);
  3363. begin
  3364.   inherited;
  3365. end;
  3366.  
  3367. procedure TRxDBCalcEdit.CMExit(var Message: TCMExit);
  3368. begin
  3369.   try
  3370.     CheckRange;
  3371.     FDataLink.UpdateRecord;
  3372.   except
  3373.     SelectAll;
  3374.     if CanFocus then SetFocus;
  3375.     raise;
  3376.   end;
  3377.   inherited;
  3378. end;
  3379.  
  3380. {$IFDEF RX_D4}
  3381. function TRxDBCalcEdit.UseRightToLeftAlignment: Boolean;
  3382. begin
  3383.   Result := DBUseRightToLeftAlignment(Self, Field);
  3384. end;
  3385.  
  3386. function TRxDBCalcEdit.ExecuteAction(Action: TBasicAction): Boolean;
  3387. begin
  3388.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  3389.     FDataLink.ExecuteAction(Action);
  3390. end;
  3391.  
  3392. function TRxDBCalcEdit.UpdateAction(Action: TBasicAction): Boolean;
  3393. begin
  3394.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  3395.     FDataLink.UpdateAction(Action);
  3396. end;
  3397. {$ENDIF}
  3398.  
  3399. { TStatusDataLink }
  3400.  
  3401. type
  3402.   TStatusDataLink = class(TDataLink)
  3403.   private
  3404.     FLabel: TDBStatusLabel;
  3405.   protected
  3406.     procedure ActiveChanged; override;
  3407.     procedure EditingChanged; override;
  3408.     procedure DataSetChanged; override;
  3409.     procedure DataSetScrolled(Distance: Integer); override;
  3410.     procedure LayoutChanged; override;
  3411.   public
  3412.     constructor Create(ALabel: TDBStatusLabel);
  3413.     destructor Destroy; override;
  3414.   end;
  3415.  
  3416. constructor TStatusDataLink.Create(ALabel: TDBStatusLabel);
  3417. begin
  3418.   inherited Create;
  3419.   FLabel := ALabel;
  3420. end;
  3421.  
  3422. destructor TStatusDataLink.Destroy;
  3423. begin
  3424.   FLabel := nil;
  3425.   inherited Destroy;
  3426. end;
  3427.  
  3428. procedure TStatusDataLink.ActiveChanged;
  3429. begin
  3430.   DataSetChanged;
  3431. end;
  3432.  
  3433. procedure TStatusDataLink.DataSetScrolled(Distance: Integer);
  3434. begin
  3435.   if (FLabel <> nil) and (FLabel.Style = lsRecordNo) then
  3436.     FLabel.UpdateStatus;
  3437. end;
  3438.  
  3439. procedure TStatusDataLink.EditingChanged;
  3440. begin
  3441.   if (FLabel <> nil) and (FLabel.Style <> lsRecordSize) then
  3442.     FLabel.UpdateStatus;
  3443. end;
  3444.  
  3445. procedure TStatusDataLink.DataSetChanged;
  3446. begin
  3447.   if (FLabel <> nil) then FLabel.UpdateData;
  3448. end;
  3449.  
  3450. procedure TStatusDataLink.LayoutChanged;
  3451. begin
  3452.   if (FLabel <> nil) and (FLabel.Style <> lsRecordSize) then
  3453.     DataSetChanged; { ??? }
  3454. end;
  3455.  
  3456. { TDBStatusLabel }
  3457.  
  3458. const
  3459.   GlyphSpacing = 2;
  3460.   GlyphColumns = 7;
  3461.  
  3462. constructor TDBStatusLabel.Create(AOwner: TComponent);
  3463. begin
  3464.   inherited Create(AOwner);
  3465.   ShadowSize := 0;
  3466.   Layout := tlCenter;
  3467.   ControlStyle := ControlStyle - [csSetCaption {$IFDEF WIN32},
  3468.     csReplicatable {$ENDIF}];
  3469.   FRecordCount := -1;
  3470.   FRecordNo := -1;
  3471.   ShowAccelChar := False;
  3472.   FDataSetName := EmptyStr;
  3473.   FDataLink := TStatusDataLink.Create(Self);
  3474.   FStyle := lsState;
  3475.   GlyphAlign := glGlyphLeft;
  3476.   FEditColor := clRed;
  3477.   FCaptions := TStringList.Create;
  3478.   TStringList(FCaptions).OnChange := CaptionsChanged;
  3479.   FGlyph := TBitmap.Create;
  3480.   FGlyph.Handle := LoadBitmap(HInstance, 'DS_STATES');
  3481.   Caption := '';
  3482. end;
  3483.  
  3484. destructor TDBStatusLabel.Destroy;
  3485. begin
  3486.   FDataLink.Free;
  3487.   FDataLink := nil;
  3488.   //DisposeStr(FDataSetName);
  3489.   TStringList(FCaptions).OnChange := nil;
  3490.   FCaptions.Free;
  3491.   FCaptions := nil;
  3492.   FCell.Free;
  3493.   FCell := nil;
  3494.   FGlyph.Free;
  3495.   FGlyph := nil;
  3496.   inherited Destroy;
  3497. end;
  3498.  
  3499. procedure TDBStatusLabel.Loaded;
  3500. begin
  3501.   inherited Loaded;
  3502.   UpdateData;
  3503. end;
  3504.  
  3505. function TDBStatusLabel.GetDefaultFontColor: TColor;
  3506. begin
  3507.   if (FStyle = lsState) and (FDatalink <> nil) and
  3508.     (GetDatasetState in [dsEdit, dsInsert]) then
  3509.     Result := FEditColor
  3510.   else Result := inherited GetDefaultFontColor;
  3511. end;
  3512.  
  3513. function TDBStatusLabel.GetLabelCaption: string;
  3514. begin
  3515.   if (csDesigning in ComponentState) and ((FStyle = lsState) or
  3516.     (FDatalink = nil) or not FDatalink.Active) then
  3517.     Result := Format('(%s)', [Name])
  3518.   else if ((FDatalink = nil) or (DataSource = nil)) then
  3519.     Result := ''
  3520.   else begin
  3521.     case FStyle of
  3522.       lsState:
  3523.         if FShowOptions in [doCaption, doBoth] then begin
  3524.           if DataSetName = '' then Result := GetCaption(DataSource.State)
  3525.           else Result := Format('%s: %s', [DataSetName, GetCaption(DataSource.State)]);
  3526.         end
  3527.         else { doGlyph } Result := '';
  3528.       lsRecordNo:
  3529.         if FDataLink.Active then begin
  3530.           if FRecordNo >= 0 then begin
  3531.             if FRecordCount >= 0 then
  3532.               Result := Format('%d:%d', [FRecordNo, FRecordCount])
  3533.             else Result := IntToStr(FRecordNo);
  3534.           end
  3535.           else begin
  3536.             if FRecordCount >= 0 then
  3537.               Result := Format('( %d )', [FRecordCount])
  3538.             else Result := '';
  3539.           end;
  3540.         end
  3541.         else Result := '';
  3542.       lsRecordSize:
  3543.         if FDatalink.Active then
  3544.           Result := IntToStr(FDatalink.DataSet.RecordSize)
  3545.         else Result := '';
  3546.     end;
  3547.   end;
  3548. end;
  3549.  
  3550. function TDBStatusLabel.GetDatasetState: TDataSetState;
  3551. begin
  3552.   if DataSource <> nil then
  3553.     Result := DataSource.State
  3554.   else Result := dsInactive;
  3555. end;
  3556.  
  3557. procedure TDBStatusLabel.SetName(const Value: TComponentName);
  3558. begin
  3559.   inherited SetName(Value);
  3560.   if (csDesigning in ComponentState) then Invalidate;
  3561. end;
  3562.  
  3563. procedure TDBStatusLabel.SetCaptions(Value: TStrings);
  3564. begin
  3565.   FCaptions.Assign(Value);
  3566. end;
  3567.  
  3568. function TDBStatusLabel.GetStatusKind(State: TDataSetState): TDBStatusKind;
  3569. begin
  3570. {$IFDEF WIN32}
  3571.   if not (State in [Low(TDBStatusKind)..High(TDBStatusKind)]) then begin
  3572.     case State of
  3573.       dsFilter: Result := dsSetKey;
  3574. {$IFDEF RX_D3}
  3575.       dsNewValue, dsOldValue, dsCurValue: Result := dsEdit;
  3576. {$ELSE}
  3577.       dsUpdateNew, dsUpdateOld: Result := dsEdit;
  3578. {$ENDIF}
  3579.       else Result := TDBStatusKind(State);
  3580.     end;
  3581.   end
  3582.   else
  3583. {$ENDIF WIN32}
  3584.     Result := TDBStatusKind(State);
  3585. end;
  3586.  
  3587. function TDBStatusLabel.GetCaption(State: TDataSetState): string;
  3588. const
  3589.   StrIds: array[TDBStatusKind] of Word = (SInactiveData, SBrowseData,
  3590.     SEditData, SInsertData, SSetKeyData, SCalcFieldsData);
  3591. var
  3592.   Kind: TDBStatusKind;
  3593. begin
  3594.   Kind := GetStatusKind(State);
  3595.   if (FCaptions <> nil) and (Ord(Kind) < FCaptions.Count) and
  3596.     (FCaptions[Ord(Kind)] <> '') then Result := FCaptions[Ord(Kind)]
  3597.   else Result := LoadStr(StrIds[Kind]);
  3598. end;
  3599.  
  3600. procedure TDBStatusLabel.Paint;
  3601. var
  3602.   GlyphOrigin: TPoint;
  3603. begin
  3604.   inherited Paint;
  3605.   if (FStyle = lsState) and (FShowOptions in [doGlyph, doBoth]) and
  3606.     (FCell <> nil) then
  3607.   begin
  3608.     if GlyphAlign = glGlyphLeft then
  3609.       GlyphOrigin.X := GlyphSpacing
  3610.     else {glGlyphRight}
  3611.       GlyphOrigin.X := Left + ClientWidth - RightMargin + GlyphSpacing;
  3612.     case Layout of
  3613.       tlTop: GlyphOrigin.Y := 0;
  3614.       tlCenter: GlyphOrigin.Y := (ClientHeight - FCell.Height) div 2;
  3615.       else { tlBottom } GlyphOrigin.Y := ClientHeight - FCell.Height;
  3616.     end;
  3617.     DrawBitmapTransparent(Canvas, GlyphOrigin.X, GlyphOrigin.Y,
  3618.       FCell, FGlyph.TransparentColor);
  3619.   end;
  3620. end;
  3621.  
  3622. procedure TDBStatusLabel.CaptionsChanged(Sender: TObject);
  3623. begin
  3624.   TStringList(FCaptions).OnChange := nil;
  3625.   try
  3626.     while (Pred(FCaptions.Count) > Ord(High(TDBStatusKind))) do
  3627.       FCaptions.Delete(FCaptions.Count - 1);
  3628.   finally
  3629.     TStringList(FCaptions).OnChange := CaptionsChanged;
  3630.   end;
  3631.   if not (csDesigning in ComponentState) then Invalidate;
  3632. end;
  3633.  
  3634. procedure TDBStatusLabel.UpdateData;
  3635.  
  3636.   function IsSequenced: Boolean;
  3637.   begin
  3638. {$IFDEF RX_D3}
  3639.     Result := FDatalink.DataSet.IsSequenced;
  3640. {$ELSE}
  3641.     Result := not ((FDatalink.DataSet is TDBDataSet) and
  3642.       TDBDataSet(FDatalink.DataSet).Database.IsSQLBased);
  3643. {$ENDIF}
  3644.   end;
  3645.  
  3646. begin
  3647.   FRecordCount := -1;
  3648.   if (FStyle = lsRecordNo) and FDataLink.Active and
  3649.     (DataSource.State in [dsBrowse, dsEdit]) then
  3650.   begin
  3651.     if Assigned(FOnGetRecordCount) then
  3652.       FOnGetRecordCount(Self, FDataLink.DataSet, FRecordCount)
  3653.     else if (FCalcCount or IsSequenced) then
  3654. {$IFDEF RX_D3}
  3655.       FRecordCount := FDataLink.DataSet.RecordCount;
  3656. {$ELSE}
  3657.       FRecordCount := DataSetRecordCount(FDataLink.DataSet)
  3658. {$ENDIF}
  3659.   end;
  3660.   UpdateStatus;
  3661. end;
  3662.  
  3663. procedure TDBStatusLabel.UpdateStatus;
  3664. begin
  3665.   if DataSource <> nil then begin
  3666.     case FStyle of
  3667.       lsState:
  3668.         if FShowOptions in [doGlyph, doBoth] then begin
  3669.           if GlyphAlign = glGlyphLeft then begin
  3670.             RightMargin := 0;
  3671.             LeftMargin := (FGlyph.Width div GlyphColumns) + GlyphSpacing * 2;
  3672.           end
  3673.           else {glGlyphRight} begin
  3674.             LeftMargin := 0;
  3675.             RightMargin := (FGlyph.Width div GlyphColumns) + GlyphSpacing * 2;
  3676.           end;
  3677.           if FCell = nil then FCell := TBitmap.Create;
  3678.           AssignBitmapCell(FGlyph, FCell, GlyphColumns, 1,
  3679.             Ord(GetStatusKind(DataSource.State)));
  3680.         end
  3681.         else { doCaption } begin
  3682.           FCell.Free;
  3683.           FCell := nil;
  3684.           LeftMargin := 0;
  3685.           RightMargin := 0;
  3686.         end;
  3687.       lsRecordNo:
  3688.         begin
  3689.           FCell.Free;
  3690.           FCell := nil;
  3691.           LeftMargin := 0;
  3692.           RightMargin := 0;
  3693.           FRecordNo := -1;
  3694.           if FDataLink.Active then begin
  3695.             if Assigned(FOnGetRecNo) then
  3696.               FOnGetRecNo(Self, FDataLink.DataSet, FRecordNo) else
  3697.             try
  3698. {$IFDEF RX_D3}
  3699.               with FDatalink.DataSet do
  3700.                 if not IsEmpty then FRecordNo := RecNo;
  3701. {$ELSE}
  3702.               FRecordNo := DataSetRecNo(FDatalink.DataSet);
  3703. {$ENDIF}
  3704.             except
  3705.             end;
  3706.           end;
  3707.         end;
  3708.       lsRecordSize:
  3709.         begin
  3710.           FCell.Free;
  3711.           FCell := nil;
  3712.           LeftMargin := 0;
  3713.           RightMargin := 0;
  3714.         end;
  3715.     end;
  3716.   end
  3717.   else begin
  3718.     FCell.Free;
  3719.     FCell := nil;
  3720.   end;
  3721.   AdjustBounds;
  3722.   Invalidate;
  3723. end;
  3724.  
  3725. procedure TDBStatusLabel.Notification(AComponent: TComponent;
  3726.   Operation: TOperation);
  3727. begin
  3728.   inherited Notification(AComponent, Operation);
  3729.   if (Operation = opRemove) and (FDataLink <> nil) and
  3730.     (AComponent = DataSource) then DataSource := nil;
  3731. end;
  3732.  
  3733. function TDBStatusLabel.GetDataSetName: string;
  3734. begin
  3735.   Result := FDataSetName;
  3736.   if not (csDesigning in ComponentState) then begin
  3737.     if Assigned(FOnGetDataName) then Result := FOnGetDataName(Self)
  3738.     else if (Result = '') and (DataSource <> nil) and
  3739.       (DataSource.DataSet <> nil) then Result := DataSource.DataSet.Name;
  3740.   end;
  3741. end;
  3742.  
  3743. procedure TDBStatusLabel.SetDataSetName(Value: string);
  3744. begin
  3745.   FDataSetName := Value;
  3746.   Invalidate;
  3747. end;
  3748.  
  3749. function TDBStatusLabel.GetDataSource: TDataSource;
  3750. begin
  3751.   Result := FDataLink.DataSource;
  3752. end;
  3753.  
  3754. procedure TDBStatusLabel.SetDataSource(Value: TDataSource);
  3755. begin
  3756. {$IFDEF RX_D4}
  3757.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  3758. {$ENDIF}
  3759.     FDataLink.DataSource := Value;
  3760. {$IFDEF WIN32}
  3761.   if Value <> nil then Value.FreeNotification(Self);
  3762. {$ENDIF}
  3763.   if not (csLoading in ComponentState) then UpdateData;
  3764. end;
  3765.  
  3766. procedure TDBStatusLabel.SetEditColor(Value: TColor);
  3767. begin
  3768.   if FEditColor <> Value then begin
  3769.     FEditColor := Value;
  3770.     if Style = lsState then Invalidate;
  3771.   end;
  3772. end;
  3773.  
  3774. procedure TDBStatusLabel.SetGlyphAlign(Value: TGlyphAlign);
  3775. begin
  3776.   if FGlyphAlign <> Value then begin
  3777.     FGlyphAlign := Value;
  3778.     UpdateStatus;
  3779.   end;
  3780. end;
  3781.  
  3782. procedure TDBStatusLabel.SetShowOptions(Value: TDBLabelOptions);
  3783. begin
  3784.   if FShowOptions <> Value then begin
  3785.     FShowOptions := Value;
  3786.     UpdateStatus;
  3787.   end;
  3788. end;
  3789.  
  3790. procedure TDBStatusLabel.SetCalcCount(Value: Boolean);
  3791. begin
  3792.   if FCalcCount <> Value then begin
  3793.     FCalcCount := Value;
  3794.     if not (csLoading in ComponentState) then UpdateData;
  3795.   end;
  3796. end;
  3797.  
  3798. procedure TDBStatusLabel.SetStyle(Value: TDBLabelStyle);
  3799. begin
  3800.   if FStyle <> Value then begin
  3801.     FStyle := Value;
  3802.     if not (csLoading in ComponentState) then UpdateData;
  3803.   end;
  3804. end;
  3805.  
  3806. {$IFDEF WIN32}
  3807. initialization
  3808. finalization
  3809.   DestroyLocals;
  3810. {$ELSE}
  3811. initialization
  3812.   AddExitProc(DestroyLocals);
  3813. {$ENDIF}
  3814. end.